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Organization  of  this  Volume 

Dealing  with  the  code  is  always  a  problem.  While  it  is,  in  a 
sense,  the  fruit  of  long  labor,  no  one  likes  to  list  it  out  and 
include  it  in  the  prose  report  which  is  almost  inevitably  the 
final  output  of  a  programming  effort.  However,  there  are  always 
questions  which  can  be  answered  only  by  appeal  to  the  code 
itself,  making  its  availability  a  necessity,  and  its  inclusion  in 
a  final  report  desirable. 

We  have  dealt  with  the  problem  by  making  the  code  a  separate 
volume  of  this  final  report.  Those  who  need  or  want  to  see  the 
messy  details  are  welcome,  while  others  can  ignore  them  without 
qualms,  and  without  the  need  to  carry  around  listings  that  will 
never  be  used. 

Code  by  itself,  even  when  commented,  can  be  particularly 
uninformative.  We  have  attempted  to  make  use  of  software 
engineering  tools  provided  by  INTERLISP  to  make  wading  through 
the  program  itself  somewhat  easier.  After  the  listing,  we 
include  a  tree  which  represents  the  calling  sequence  of  the 
functions  that  make  up  STAMMER.  It  is  important  to  not  that  not 
all  of  the  functions  in  the  code  will  be  included  in  this  tree, 
as  some  are  intended  to  be  top-level  calls  only,  rather  than 
called  by  other  functions.  However,  this  does  give  an  idea  of 
the  flow  through  the  functions  during  normal  execution. 

Following  the  calling  sequence  tree,  we  provide  a  brief 
description  of  each  function,  in  alphabetical  order.  This 


description  includes  calling  and  called-by  information,  along 
with  variable  binding  information. 

The  insert  before  the  code  proper  is  a  cross-reference  from  an 
alphabetical  listing  of  function  names  to  the  name  of  the  file  in 
which  they  are  included.  This  should  make  looking  up  code  much 
easier,  since  the  files  are  organized  functionally,  rather  than 
lexically.  This  index  also  includes  all  properties  and  variables 
which  are  set  in  the  file,  though  these  are  not  given  reference 


numbers 
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Summary  for  files: 


<RBECHTAL>CONFIDENCE. .23 
<PMORRIS>DSPLA. LSP. 88 
<PMORRIS>FORK.LSP. 19 
<RBECHTAL>HASHER. .38 
<RBECHTAL> INTERP. .37 
<RBECHTAL>MANIPULATE. .20 
<RBECHTAL>MEMORY. .17 
<RBECHTAL>MSGMTR.  .27 
<DKIBLER>NEWEXP. LSP. 34 
<DKIBLER>ORACLE. LSP. 40 
<DKIBLER>PLAT. LSP. 4  8 
<PMORRlS>QH. LSP.  72 
<RBECHTAL>RULES.  .29 
<PM0RRIS>STREAM.  LSP.  37 
<RBECHTAL>TOPLEVEL. .13 


24-JU1-79  13:44:49 
10-Aug-79  16:19:32 
18-Dec-78  16:30:43 

7- Aug-79  19:03:11 
28-Aug-79  21:06:16 

6-Aug-79  17:32:02 
6 -Aug -7 9  19:06:57 
23-Aug-79  17:56:55 
28-Aug-79  11:42:07 

8- Aug-79  09:11:09 
6 -Aug-7 9  11:01:49 

21-Aug-79  12:09:01 
27 -Aug-7 9  21:39:39 
6-Aug-79  20:15:2 0 
21-Aug-79  11:08:03 


<ATTIS> 

NEWEXP 

<EXPLTREE> 

NEWEXP 

<ID2> 

NEWEXP 

< IDAMP2  > 

NEWEXP 

<IDAMPIS> 

NEWEXP 

<IDIS> 

NEWEXP 

<OCCURNUH> 

NEWEXP 

<OTHER2> 

NEWEXP 

<PLATIS> 

NEWEXP 

<TELLABT> 

NEWEXP 

<TYPE2> 

NEWEXP 

<TYPIS> 

NEWEXP 

<VALIS> 

NEWEXP 

<WHAT2FORM> 

NEWEXP 

<WHATFORM> 

NEWEXP 

<WHEREFORM> 

NEWEXP 

<WHEREITEM> 

NEWEXP 

<WHOSE2FORM> 

NEWEXP 

<WHOSEFORfI> 

NEWEXP 

ADDH 

88 

HASHER 

ADDIS 

257 

TOPLEVEL 

AFTERSYSOUTFORMS 

FORK 

ALIAS 

NEWEXP 

ANDHACK 

103 

INTERP 

APPLYRULE 

104 

INTERP 

ARRLOC 

75 

FORK 

ASSERT 

117 

MANIPULATE 

ASSERTION 

NEWEXP 

ASSRPRINT 

148 

NEWEXP 

AUXINTERPOL 

222 

PLAT 

BEARING 

ORACLE 

BEARING 

ORACLE 

BEARING 

181 

ORACLE 

BEEP 

231 

QH 

BEYONDINTEREST 

128 

MSGMTR 

BKDSPBUF 

28 

DSPLA 

BLFN 

5 

CONFIDENCE 

BLOCK ED-FROM 

NEWEXP 

if prop:  QHPRODS 
if prop:  QHPRODS 
if prop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 
ifprop:  QHPRODS 

expr :  (ARGS  NEWVAL) 
expr:  (SN) 

ADDVARS 

ifprop:  PR INFORMS 

expr:  (CONDITIONS  ACTIONS  EV) 
expr:  (RULENAME  PREBIND) 
expr:  (ARR) 

expr:  (ARGLIST  NODENAME) 

Set  Variable 


expr 

(PRINSPEC) 

expr 

(PT1  PT2  DELTA) 

ifprop 

ORACLE 

ifprop 

ORTYPE 

expr 

(SITE) 

expr 

NIL 

expr 

(TXT) 

expr 

(X) 

expr 

(BNODE) 

ifprop 

PR INFORMS 

Nap  for  files:  CONFIDENCE,  DSPLA,  FORK,  HASHER,  INTERP 
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BLOCKER 

RULES 

prop:  CONDITIONS 

BLOCKER 

RULES 

prop:  ACTIONS 

BLOCKER 

RULES 

prop:  CONF 

BHEAS 

4  CONFIDENCE 

expr:  (BBOX) 

BUMP 

118  MANIPULATE 

expr:  (L) 

CASSERT 

119  MANIPULATE 

expr:  (SPEC  VAL) 

CENTROID 

223  PLAT 

expr:  (VERTEXLIST) 

CHANG ECON 

149  NEWEXP 

expr:  (RLNME1) 

CKCONFIGURATION 

258  TOPLEVEL 

expr:  NIL 

CLASS 

NEWEXP 

if prop:  PR INFORMS 

CLOSE-POPUP 

RULES 

prop:  CONDITIONS 

CLOSE-POPUP 

RULES 

prop:  ACTIONS 

CLOSE-POPUP 

RULES 

prop:  CONF 

CONFIDEBLOCK 

CONFIDENCE 

BLOCKS 

CONSTRUCT 

105  INTERP 

expr:  (ACTIONS  EV  COUNT) 

CONTACT 

NEWEXP 

if prop:  PRINFORMS 

COURSE 

NEWEXP 

if prop:  PRINFORMS 

COURSE 

ORACLE 

if prop:  ORACLE 

COURSE 

ORACLE 

if prop:  ORTYPE 

COURSE 

211  ORACLE 

expr:  (SITE) 

COURSE-CHANGED 

RULES 

prop:  CONDITIONS 

COURSE-CHANGED 

RULES 

prop:  ACTIONS 

COURSE-CHANGED 

RULES 

prop:  CONF 

COURSEFROM 

NEWEXP 

if prop:  PRINFORMS 

COURSEFROM 

ORACLE 

if prop:  ORACLE 

COURSEFROM 

ORACLE 

ifprop:  ORTYPE 

COURSEFROM 

213  ORACLE 

expr:  (POS1  POS2) 

CREATECONTACT 

RULES 

prop:  CONDITIONS 

CREATECONTACT 

RULES 

prop:  ACTIONS 

CREATECONTACT 

RULES 

prop:  CONF 

CREATEDETECT 

RULES 

prop:  CONDITIONS 

CREATEDETECT 

RULES 

prop:  ACTIONS 

CREATEDETECT 

RULES 

prop:  CONF 

CREATEPLAT 

RULES 

prop:  CONDITIONS 

CREATEPLAT 

PULES 

prop:  ACTIONS 

CREATEPLAT 

RULES 

prop:  CONF 

CREATH 

89  HASHER 

expr:  (SIZE) 

CROSSBOUNDARY 

188  ORACLE 

expr:  (PT1  PT2  POLY) 

CROSSLINES 

191  ORACLE 

expr:  (A  B  P  Q) 

CROSSPATHS 

NEWEXP 

ifprop:  PRINFORMS 

CROSSPATHS 

ORACLE 

ifprop:  ORACLE 

CROSSPATHS 

ORACLE 

ifprop:  ORTYPE 

CROSSPATHS 

197  ORACLE 

expr:  (SI  S2  T1  T2) 

CRUNCH 

18  DSPLA 

expr:  (X) 

CURTIME 

MSGMTR 

Saved  Variable 

DECSAMEDIGITS 

29  DSPLA 

expr:  (X) 

DEFINEPD 

236  RULES 

expr:  NIL 

DENY 

120  MANIPULATE 

fexpr*:  L 

DESCRIBEMSG 

129  MSGMTR 

expr:  (TXT) 

DETECTION 

NEWEXP 

ifprop:  PRINFORMS 

DIRECTION 

209  ORACLE 

expr:  (LAT1  LONl  LAT2  LON2) 

DISPCHECK 

130  MSGMTR 

expr:  (NAME) 

DISPLAY 

131  MSGMTR 

expr:  (PLATNAME  LAT  LON  TIME) 

DISPLOB 

132  MSGMTR 

expr:  ( PNAME  SPOS  DPOS  TIME) 

DISPMARK 

133  MSGMTR 

expr:  (NAME) 

DISSIMILAR 

NEWEXP 

ifprop:  PRINFORMS 

DISSIMILPLAT 

200  ORACLE 

expr:  ( PLAT1  PLAT2 ) 

Nap  for  f ilea:  CONFIDENCE,  DSPLA,  FORK,  HASHER,  INTERP 
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DISTANCE 

184 

ORACLE 

DISTANT-POPUP 

RULES 

DISTANT- POPUP 

RULES 

DISTANT-POPUP 

RULES 

DISTOLINE 

185 

ORACLE 

DLFN 

8 

CONFIDENCE 

DMEAS 

7 

CONFIDENCE 

DSPADDINC 

23 

DSPLA 

DSPADDINCS 

41 

DSPLA 

DSPADDTRH 

22 

DSPLA 

DSPCHGTRH 

42 

DSPLA 

DSPCMD 

14 

DSPLA 

DSPCNVRT 

19 

DSPLA 

DSPERASE 

35 

DSPLA 

DSPEXCH 

36 

DSPLA 

DSPEXCHBUF 

DSPLA 

DSPEXCHEMP 

DSPLA 

DSPEXP 

172 

NEWEXP 

DSPGRAB 

24 

DSPLA 

DSPINIT 

15 

DSPLA 

DSPLAYFLG 

MSGMTR 

DSPMAP 

37 

DSPLA 

DSPNOMAP 

38 

DSPLA 

DSPNOWAITFLG 

FORK 

DSPNUMAT 

20 

DSPLA 

DSPQUIET 

27 

DSPLA 

DSPRELD 

25 

DSPLA 

DSPSAVE 

43 

DSPLA 

DSPSTAT 

40 

DSPLA 

DSPTOP 

39 

DSPLA 

DSPTTY 

26 

DSPLA 

DSPTTYSTR 

31 

DSPLA 

DUALFLG 

TOPLEVEL 

DULLREL 

NEWEXP 

EMITTER 

NEWEXP 

ENDSTREAM 

240 

STREAM 

ESTIMATE 

216 

PLAT 

EWMSG 

134 

MSGMTR 

EXLOOP 

259 

TOPLEVEL 

EXPLAIN 

150 

NEWEXP 

EXPLAINFLAG 

NEWEXP 

FANCYPROD 

238 

RULES 

FASTER-THAN-A-MERCHANT 

RULES 

FASTER-THAN-A-MERCHANT 

RULES 

FASTER- THAN- A- MERCHANT 


expr:  (LAT1  LONl  LAT2  LON2) 
prop:  CONDITIONS 
prop:  ACTIONS 
prop:  CONF 

expr:  (X  Y  XI  Y1  X2  Y2) 
expr:  (DNODE) 
expr:  (DBOX) 

expr:  (NAME  LAT  LON  TIME) 
expr:  (NAME  INCLST) 
expr:  (NAME  ID  TYPE) 
expr:  (NAME  ID  TYPE) 
expr:  (CMD  WAITFLG) 
expr:  (X) 
expr:  NIL 
expr:  (NAME) 

Set  Variable 
Set  Variable 
expr:  (BOX) 
expr:  (TTYNO) 
expr:  NIL 
Saved  Variable 
expr:  NIL 
expr:  NIL 
Set  Variable 
expr:  (X) 
expr:  NIL 
expr:  NIL 
expr :  NIL 
expr :  NIL 
expr:  (WAITFLG) 
expr :  NIL 
expr:  NIL 
Saved  Variable 
Set  Variable 
if prop:  PR INFORMS 
expr:  (S) 

expr:  (SITE1  SITE2  GAP) 
expr:  (TXT  EXTFLG) 
expr :  NIL 
expr:  NIL 
Saved  Variable 
expr:  (PRO) 

prop:  CONDITIONS 

prop:  ACTIONS 


RULES 

prop:  CONF 

FASTHAK 

90 

HASHER 

expr:  NIL 

FIRST-SIGHTING 

NEWEXP 

if prop:  PRINFORMS 

FIRST-VIEW 

RULES 

prop:  CONDITIONS 

FIRST- VIEW 

RULES 

prop:  ACTIONS 

FIRST- VIEW 

RULES 

prop:  CONF 

FIXLONG 

225 

PLAT 

expr:  (X) 

FKACS 

54 

FORK 

expr :  NIL 

FKACSRETURN 

55 

FORK 

expr:  (ARRAY) 

FKARRADR 

73 

FORK 

expr:  ( FKARRNAM1 

Map  for  f Hast  CONFIDENCE,  DSPLA,  FORK,  HASHER,  INTERP 
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FKARRAY 

62  FORK 

fexpr:  (FKA  FKTYPE  FKSIZE  FKSIZE2) 

FK ARRA YB  LOCK 

FORK 

BLOCKS 

FKARRAYP 

68  FORK 

expr:  (A) 

FKARRAYSIZE 

69  FORK 

expr :  (A) 

FKARRAYTYPE 

71  FORK 

expr:  (A) 

FKBCHECK 

72  FORK 

expr:  (N  LO  HI) 

FKCALL 

48  FORK 

fexpr*:  FKCX 

FKCALLBLOCK 

FORK 

BLOCKS 

FKCALL ERR 

58  FORK 

expr:  (FKCID) 

FKCATYPE 

49  FORK 

expr:  (FKID) 

FKCORGET 

63  FORK 

expr:  (SIZE) 

FKDDT 

47  FORK 

expr:  (DDTFILE) 

FKDDT 

FORK 

prop:  MACRO 

FKDDT_ 

FORK 

prop:  MACRO 

FKELT 

64  FORK 

fexpr:  (FKELTI A  FKELT IN  FKELTI WORDS) 

FKELTI 

65  FORK 

fexpr:  (FKELTI 1 A  FKELTI IN 

FKELTI (WORDS) 

FKELTR 

66  FORK 

fexpr:  (FKELTR! A  FKELTR IN 

FKELTR I WORDS) 

FKFLOAT 

74  FORK 

expr:  (ADR) 

FKHALT 

FORK 

prop:  MACRO 

FKHNDL 

FORK 

prop:  MACRO 

FKHT 

FORK 

prop:  MACRO 

FKHT_ 

FORK 

prop:  MACRO 

FKIDPB 

FORK 

prop:  MACRO 

FKINIT 

44  FORK 

fexpr:  (PROGRAM) 

FKJFN 

FORK 

prop:  MACRO 

FKJSYS 

85  FORK 

expr:  (FKJSYSNO  ARG1  ARG2  ARG3  ARG4 

ARG5) 

FKJSYSARG 

86  FORK 

expr:  (X) 

FKJSYSBLOCK 

FORK 

BLOCKS 

FKKILL 

45  FORK 

expr:  NIL 

FKPROG 

FORK 

prop:  MACRO 

FKRACS 

FORK 

prop:  MACRO 

FKRTN 

56  FORK 

expr:  (TYPE  A  N) 

FKSACS 

FORK 

prop:  MACRO 

FKSAVE 

46  FORK 

expr:  (FILE) 

FKSETA 

67  FORK 

fexpr:  (FKARRY  FKINDEX  FKEXPR) 

FKSETVAL 

79  FORK 

fexpr:  ( FKADR  FKBIAS  FKVAL) 

FKSHR 

FORK 

prop:  MACRO 

FKSR 

50  FORK 

expr:  (A  I  STR) 

FKSW 

59  FORK 

expr:  (FKHNDL  I  FKNOWAITFLG) 

FKSYM 

80  FORK 

expr:  (ID  FKHT  NOBREAK) 

FKSYMACS 

FORK 

prop:  MACRO 

FKSYMBLOCK 

FORK 

BLOCKS 

FKSYMP 

82  FORK 

expr:  (ID) 

FKSYMPUT 

81  FORK 

expr:  (FKHT  ID  V) 

FKTIME 

84  FORK 

expr:  (FKEXPR) 

FKTTYSET 

61  FORK 

expr:  (BOOL) 

FKVAL 

76  FORK 

fexpr:  (FKADR  FKBIAS  FKWORDS) 

FKVALAT 

21  DSPLA 

fexpr:  (ID  BIAS  NVALS) 

FKVAL I 

78  FORK 

fexpr:  (FKADR  FKBIAS  FKWORDS  FKREAL) 

FKVALR 

77  FORK 

fexpr:  (FKADR  FKBIAS  FKWORDS) 

FKWAIT 

87  FORK 

expr:  (FKHNDL) 

FKX 

60  FORK 

fexpr:  (FKCX) 

FREEZE 

241  STREAM 

expr:  NIL 

FREEZEFLG 

STREAM 

Set  Variable 
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PREEZELST 

STREAM 

Set  Variable 

PROM- PORT 

NEWEXP 

if prop: 

PRINFORMS 

GAMF 

151 

NEWEXP 

expr 

(WLK  OVERRIDE) 

GET ATT 

215 

PLAT 

expr 

(REL  NAME) 

GETATTB 

178 

ORACLE 

expr 

(REL  NODE) 

GETCON 

1 

CONFIDENCE 

expr 

(SOMAST) 

GETH 

91 

HASHER 

expr 

(ARGS) 

GETMARK 

2 

CONFIDENCE 

expr 

(NODE) 

GETMB 

3 

CONFIDENCE 

expr 

(BAST) 

GETMD 

6 

CONFIDENCE 

expr 

(DAST) 

GETMRVAL 

250 

STREAM 

expr 

(X  COPYFLG) 

GETPOINT 

224 

PLAT 

expr 

(POS  BEAR  RANGE) 

GETPULSAR 

106 

INTERP 

expr 

(NODE) 

GETRADIX50 

83 

FORK 

expr 

(S) 

GETSH 

92 

HASHER 

expr 

(ARGS) 

GETSTRIP 

93 

HASHER 

expr 

(ARGS) 

GETUPLE 

121 

MANIPULATE 

expr 

(ASSER) 

GLOBALVARS 

FORK 

ADDVARS 

GRATEK 

11 

DSPLA 

expr 

NIL 

GRAZE 

NEWEXP 

if prop 

PRINFORMS 

GRAZE 

ORACLE 

if prop 

ORACLE 

GRAZE 

ORACLE 

if prop 

ORTYPE 

GRAZE 

206 

ORACLE 

expr 

(SI  S2  T1  T2) 

GREATER-THAN 

NEWEXP 

if prop* 

PRINFORMS 

GREATER-THAN 

ORACLE 

if prop 

ORACLE 

GREATER-THAN 

ORACLE 

if prop 

ORTYPE 

GREATER-THAN 

179 

ORACLE 

expr 

(Q1  Q2) 

GREATESTPROB 

135 

MSGMTR 

expr 

(POSLIST) 

HLPEXPLN 

152 

NEWEXP 

expr 

NIL 

ID 

NEWEXP 

if prop 

PRINFORMS 

ID-AMPLIFY 

NEWEXP 

if prop 

PRINFORMS 

ID-LANE 

RULES 

prop:  CONDITIONS 

ID-LANE 

RULES 

prop:  ACTIONS 

ID-LANE 

RULES 

prop:  CONF 

IDENT 

136 

MSGMTR 

expr 

(NAME) 

IMPLIES ASRT 

153 

NEWEXP 

expr 

(NODE) 

IN- LANE 

NEWEXP 

if prop 

PRINFORMS 

IN- LANE 

ORACLE 

if prop 

ORACLE 

IN- LANE 

ORACLE 

if prop 

ORTYPE 

IN-LANE 

176 

ORACLE 

expr 

(MLANE  POS) 

INCLUDEPLAT 

260 

TOPLEVEL 

expr 

(PNE) 

INHERIT 

RULES 

prop:  CONDITIONS 

INHERIT 

RULES 

prop:  ACTIONS 

INHERIT 

RULES 

prop:  CONF 

INLANE 

186 

ORACLE 

expr 

(X  Y  LANE) 

INSIDE 

NEWEXP 

if prop 

PRINFORMS 

INSIDE 

ORACLE 

if prop 

ORACLE 

INSIDE 

ORACLE 

if prop 

ORTYPE 

INSIDE 

177 

ORACLE 

expr:  (POS  STORM) 

INSIDE-A-MERCHANTLANE 

NEWEXP 

if prop 

PRINFORMS 

INSIDE-A-STORM 

RULES 

prop:  CONDITIONS 

INS IDE- A- STORM 

RULES 

prop:  ACTIONS 

INSIDE-A-STORM 

RULES 

prop:  CONF 

INTERIOR 

183 

ORACLE 

expr 

(OLAT  OLON  POLYGON) 

INTERPOLABLE 

137 

MSGMTR 

expr 

(TXT) 

JUGGLE 

154 

NEWEXP 

expr 

(PAIR  INSERTITEM) 

1 
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JUSTBUILD 

107 

INTERP 

expr :  (SPEC  EV  NUMBER) 

LAND-DIST 

NEWEXP 

if prop:  PR INFORMS 

LANERANGE 

195 

ORACLE 

expr:  (ALAT  ALON  BLAT  BLON  CLAT  CLON) 

LESS-THAN 

NEWEXP 

if prop:  PRINFORMS 

LESS-THAN 

ORACLE 

if prop:  ORACLE 

LESS-THAN 

ORACLE 

if prop:  ORTYPE 

LESS-THAN 

180 

ORACLE 

expr:  (Q1  Q2) 

LINEREAD 

239 

RULES 

expr:  NIL 

L INPOLY 

187 

ORACLE 

expr:  (PT1  PT2  POLY) 

LOC-TIME 

203 

ORACLE 

expr:  (S) 

LOCATION 

NEWEXP 

if prop:  PRINFORMS 

LOCATION 

198 

ORACLE 

expr:  (S) 

LOCH 

94 

HASHER 

expr:  (ARGS  PUTFLG) 

M 

12 

DSPLA 

fexpr*:  L 

MAKE PD 

237 

RULES 

expr:  (NAM  CO  AC  TRUST) 

MAKEPRINT 

155 

NEWEXP 

expr:  (RELN) 

MAPH 

95 

HASHER 

expr:  (ARY  ARYSZ  ARYFN) 

MAPRETALIST 

STREAM 

Set  Variable 

MAPRETDO 

245 

STREAM 

expr:  (SELT  AI) 

MAPRETRIEVE 

244 

STREAM 

expr:  (MAPRETX  MAPRETINFO  MAPRETFN) 

MAPSTREAM 

242 

STREAM 

expr:  (MAPSTREAMX  MAPSTREAMINFO 

MAPSTREAMFN) 

MARKOFF 

9 

CONFIDENCE 

expr:  (NODE) 

MARKON 

10 

CONFIDENCE 

expr:  (NODE  MARK) 

MAS SAG El 

108 

INTERP 

expr:  (SPECLIST) 

MATCH- PLAT 

RULES 

prop:  CONDITIONS 

MATCH- PLAT 

RULES 

prop:  ACTIONS 

MATCH- PLAT 

RULES 

prop:  CONF 

MATCHER 

122 

MANIPULATE 

expr:  (LI  L2) 

MAXSHIPSPEED 

ORACLE 

Saved  Variable 

MAYBE 

123 

MANIPULATE 

fexpr*:  L 

MEDIUM 

138 

MSGMTR 

expr:  (NAME) 

MEDIUM 

NEWEXP 

if prop:  PRINFORMS 

MELD 

139 

MSGMTR 

expr:  (ID  MED) 

MEMDENSITY 

96 

HASHER 

expr:  NIL 

MEMFACTOR 

HASHER 

Saved  Variable 

MEMLIMIT 

HASHER 

Saved  Variable 

MEMORY 

HASHER 

Saved  Variable 

MEMSAVE 

156 

NEWEXP 

expr:  (FEE) 

MEMSIZE 

HASHER 

Saved  Variable 

MEMTEST 

97 

HASHER 

expr:  (X  Y) 

MERCHANTLANE 

NEWEXP 

if prop:  PRINFORMS 

MIDP 

140 

MSGMTR 

expr:  (PI  P2) 

MODE 

NEWEXP 

if prop:  PRINFORMS 

MODIFIER 

157 

NEWEXP 

expr:  NIL 

MONTEK 

13 

DSPLA 

expr:  NIL 

MSGFILE 

MSGMTR 

Saved  Variable 

MSGMTP 

141 

MSGMTR 

expr:  NIL 

NEAREST 

217 

PLAT 

expr:  (PT  LST) 

NEWHASH 

98 

HASHER 

expr:  NIL 

NEWSTREAM 

243 

STREAM 

expr:  NIL 

NEWSYM 

142 

MSGMTR 

expr:  (NAME) 

NEWVALOBJ 

158 

NEWEXP 

expr:  (ARRT) 

NEXTH 

99 

HASHER 

expr:  (LOC  ARG) 

NICEANSWER 

159 

NEWEXP 

expr:  (ANSI) 

NOFORK 

57 

FORK 

expr:  NIL 

NOT-FIRST 

NEWEXP 

if prop:  PRINFORMS 
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NOT-FIRST-SIGHTING 

RULES 

NOT-FIRST-SIGHTING 

RULES 

NOT-FIRST-SIGHTING 

RULES 

NOT-KNOWN-COMBATANT 

RULES 

NOT-KNOWN-COMBATANT 

RULES 

NOT-KNOWN-COMBATANT 

RULES 

NOT-LAST 

NEWEXP 

NOT-LAST-SIGHTING 

RULES 

NOT-LAST-SIGHTING 

RULES 

NOT-LAST-SIGHTING 

RULES 

NOTHACK 

109 

INTERP 

OCCURPRINT 

160 

NEWEXP 

OCTSAMEDIGITS 

30 

DSPLA 

ONEPOINT 

218 

PLAT 

OPSIDES 

192 

ORACLE 

ORACLEHACK 

110 

INTERP 

ORACLES 

ORACLE 

ORBUILD 

111 

INTERP 

ORHACK 

112 

INTERP 

OUTS IDE- ALL-LANES 

RULES 

OUTS IDE- ALL- LANES 

RULES 

OUTS IDE-ALL- LANES 

RULES 

OWNMSG 

143 

MSGMTR 

OWNPOS 

144 

MSGMTR 

OWNSHIP 

MSGMTR 

OWNSHIP 

NEWEXP 

PARTING 

261 

toplev; 

PATROL 

NEWEXP 

PLATFORM 

NEWEXP 

PLATPOS 

219 

PLAT 

POSITION 

NEWEXP 

POSS-REPORT 

199 

ORACLE 

POSS-RPT 

RULES 

POSS-RPT 

RULES 

POSS-RPT 

RULES 

POSSIBLE-REPORT 

NEWEXP 

PQ 

226 

QH 

PREDECESSOR 

ORACLE 

PREDECESSOR 

ORACLE 

PREDECESSOR 

208 

ORACLE 

PREDICTPOS 

220 

PLAT 

PREHASH 

100 

HASHER 

PREPALIST 

248 

STREAM 

PRETTYANS 

161 

NEWEXP 

PRETTYASSR 

162 

NEWEXP 

PRJNCHAR 

16 

DSPLA 

PRINTRULEASSR 

163 

NEWEXP 

PRODUCTIONS 

RULES 

PULSAR 

253 

STREAM 

PULSE 

254 

STREAM 

PUTH 

101 

HASHER 

PUTSH 

102 

HASHER 

PUTSTREAM 

255 

STREAM 

PUTTYP 

FORK 

QHASK 

230 

QH 

QHCLEAR 

227 

QH 

QHFOLLOW 

233 

QH 

prop:  CONDITIONS 
prop:  ACTIONS 
prop:  CONF 
prop:  CONDITIONS 
prop:  ACTIONS 
prop:  CONF 
if prop:  PRINFORMS 
prop:  CONDITIONS 
prop:  ACTIONS 
prop:  CONF 

expr :  (CONDITIONS  ACTIONS  EV) 

expr :  (TIMES  NODE) 

expr:  (X) 

expr:  (NODE  GAP) 

expr :  (A  B  P  Q) 

expr:  (SPEC) 

Saved  Variable 
expr:  (SPEC  EV) 
expr:  (CONDITIONS  ACTIONS  EV) 
prop:  CONDITIONS 
prop:  ACTIONS 
prop:  CONF 
expr:  (TXT) 
expr:  (TIME) 

Saved  Variable 
if prop:  PRINFORMS 
expr:  NIL 
ifprop:  PRINFORMS 
if prop:  PRINFORMS 
expr:  (PLAT  TIME) 
ifprop:  PRINFORMS 
expr:  (SI  S2  PATROL) 
prop:  CONDITIONS 
prop:  ACTIONS 
prop:  CONF 
ifprop:  PRINFORMS 
fexpr*:  L 
ifprop:  ORACLE 
ifprop:  ORTYPE 
expr:  (SITE) 
expr:  (NODELIST  TIME) 
expr:  (L) 

expr:  (CON  ASS  ALIST) 
expr:  ( ANSLST) 

expr:  (NODE  FORMAT  OVERCONF) 
expr:  (CODE) 
expr:  (RULEASSRTS) 

Saved  Variable 
expr:  NIL 
expr:  (PULSAR) 
expr:  (ARGS  AVAL) 
expr:  (ARGS  AVAL) 
expr:  (S  X) 
prop:  MACRO 
expr:  ( INBUF) 
expr:  NIL 

expr:  (LL  BUFPTR  QHMATCH) 
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QHGET 

QH 

QHLIST 

229 

QH 

QHMAKE 

228 

QH 

QHPREP 

234 

QH 

QHPUT 

QH 

QHSHOW 

235 

QH 

QHTAKE 

232 

QH 

RADAR-MODE 

NEWEXP 

RANGE 

NEWEXP 

RANGE 

ORACLE 

RANGE 

ORACLE 

RANGE 

210 

ORACLE 

REACHABLE 

RULES 

REACHABLE 

RULES 

REACHABLE 

RULES 

REACHABLE-BY-A- 

■COMBATANT 

NEWEXP 

RECAPCONCS 

164 

NEWEXP 

RELATIONS 

NEWEXP 

RESOUT 

165 

NEWEXP 

RESULTLIST 

TOPLEVEL 

RESULTPRINTER 

166 

NEWEXP 

RETPULSEDO 

246 

STREAM 

RETRIEVER 

124 

MANIPULATE 

RETRIEVES 

247 

STREAM 

RETSTREAM 

249 

STREAM 

RETVARS 

125 

MANIPULATE 

ROTSENSE 

193 

ORACLE 

ROUGHLY-THE-SAME-COURSE-AS 

NEWEXP 

ROUGHLY-THE-SAME-COURSE-AS 

ORACLE 

ROUG  HL Y-TH  E- SAME-COUPS  E- AS 

ORACLE 

ROUGHLY-THE-SAME-COURSE-AS 

175  ORACLE 

ROUGHLY-THE-SAME-SPEED-AS 

NEWEXP 

ROUGHLY-THE-SAME-SPEED-AS 

ORACLE 

ROUGHLY-THE-SAME-SPEED-AS 

ORACLE 

ROUGHLY-THE-SAME-SPEED-AS 


RULE 

174 

ORACLE 

NEWEXP 

RULEXP 

167 

NEWEXP 

SAILARG 

52 

FORK 

SAILARRAYSIZE 

70 

FORK 

SAILCALL 

51 

FORK 

SAILSTRING 

SAME-AS 

SAME-AS 

SAME-AS 

53 

FORK 

NEWEXP 

ORACLE 

ORACLE 

SAME-AS 

173 

ORACLE 

SAVEPULSAR 

SCRATCHFIVE 

SCRATCHTEN 

113 

INTERP 

DSPLA 

DSPLA 

MACROS 

expr:  (PTR) 

expr:  (QHMAKEX  QHMAKEY  SHOWFLG) 
expr:  (FOCUS  QHLST  SHOWFLG  STK) 
MACROS 
expr:  (L) 
fexpr*:  L 
if prop:  PR INFORMS 
if prop:  PR INFORMS 
ifprop:  ORACLE 
if prop:  ORTYPE 
expr:  (SITE) 
prop:  CONDITIONS 
prop:  ACTIONS 
prop:  CONF 

ifprop:  PRINFORMS 
expr :  NIL 
Saved  Variable 
expr:  NIL 
Saved  Variable 


expr : 

(RES1) 

expr : 

(SELTAI) 

expr : 

(SPEC) 

expr : 

(AT  OBJ  VAL  SEL) 

expr : 

(C) 

expr : 

(SPEC) 

expr : 

(A  B  C) 

ifprop: 

PRINFORMS 

ifprop: 

ORACLE 

ifprop: 

ORTYPE 

expr : 

(Q1  Q2) 

ifprop: 

PRINFORMS 

ifprop: 

ORACLE 

ifprop: 

ORTYPE 

expr : 

(Q1  Q2) 

Set  Variable 

expr : 

(RULE  NODE) 

expr : 

(FKARG  FKHT) 

expr : 

(A) 

fexpr 

*:  FKCX 

expr : 

(STRING) 

ifprop: 

PRINFORMS 

ifprop: 

ORACLE 

ifprop: 

ORTYPE 

expr : 

(W  U) 

expr : 

(NODE) 

Set  Variable 

Set  Variable 
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SENSORANGE  MSGMTR  Saved  Variable 

SENSORMSG  145  MSGMTR  expr :  (TXT) 

SERT  126  MANIPULATE  expr:  (SPEC  NODENAME) 

SIGHTING  NEWEXP  ifprop:  PRINFORMS 

SIMPLY-REACHABLE  RULES  prop:  CONDITIONS 

SIMPLY-REACHABLE  RULES  prop:  ACTIONS 

SIMPLY-REACHABLE  RULES  prop:  CONF 

SIMPLY-WITH IN-REACH  NEWEXP  ifprop:  PRINFORMS 

SLOWER-THAN-A-KERCHANT 

RULES  prop:  CONDITIONS 

SLOWER-THAN-A-MERCHANT 

RULES  prop:  ACTIONS 

SLOWER-THAN-A-MERCHANT 

RULES  prop:  CONF 

SMALL-CRAFTI  RULES  prop:  CONDITIONS 

SMALL-CRAFTI  RULES  prop:  ACTIONS 

SMALL-CRAFTI  RULES  P^p:  CONF 

SMALL-CRAFT2  RULES  prop:  CONDITIONS 

SMALL- CRAFT2  RULES  prop:  ACTIONS 

SMALL-CRAFT2  RULES  prop:  CONF 

SMALL-CRAFT3  RULES  prop:  CONDITIONS 

SMALL-CRAFT3  RULES  prop:  ACTIONS 

SMALL- CRAFT3  RULES  prop:  CONF 

SMALL-CRAFT4  RULES  prop:  CONDITIONS 

SMALL-CRAFT4  RULES  prop:  ACTIONS 

SMALL-CRAFT4  RULES  prop:  CONF 

SMALL-CRAFT5  RULES  prop:  CONDITIONS 

SMALL-CRAFT5  RULES  prop:  ACTIONS 

SMALL-CRAFT5  RULES  prop:  CONF 

SMALL-CRAFT6  RULES  prop:  CONDITIONS 

SMALL-CRAFT6  RULES  prop:  ACTIONS 

SMALL- CRAFT6  RULES  prop:  CONF 

SMALL-CRAFT9  RULES  prop:  CONDITIONS 

SMALL-CRAFT9  RULES  prop:  ACTIONS 

SMALL- CRAFT9  RULES  prop:  CONF 


SMALLNUMB 

NEWEXP 

Set  Variable 

SOMELINESEG 

189 

ORACLE 

expr:  (SOMELINESEGX 

SOMELINESEGFN) 

SOMEPULSE 

251 

STREAM 

expr:  (PULSAR  PULSARDATA  SOMEPULSEFN) 

SOURCE 

NEWEXP 

ifprop:  PRINFORMS 

SPAN 

221 

PLAT 

expr:  (LI  L2) 

SPEED 

NEWEXP 

ifprop:  PRINFORMS 

SPEED 

ORACLE 

ifprop:  ORACLE 

SPEED 

ORACLE 

ifprop:  ORTYPE 

SPEED 

182 

ORACLE 

expr:  (SITE) 

SPEED-CHANGED 

RULES 

prop:  CONDITIONS 

SPEED-CHANGED 

RULES 

prop:  ACTIONS 

SPEED-CHANGED 

RULES 

prop:  CONF 

SPEEDAUX 

212 

ORACLE 

expr:  (T1  T2  DIST) 

SPEEDFROM 

NEWEXP 

ifprop:  PRINFORMS 

SPEEDFROM 

ORACLE 

ifprop:  ORACLE 

SPEEDFROM 

ORACLE 

ifprop:  ORTYPE 

SPEEDFROM 

214 

ORACLE 

expr:  (POS1  T1  POS2 

T2) 

SPEEDM 

205 

ORACLE 

expr:  (T1  T2  DIST) 

STAMMER 

262 

TOPLEVEL 

expr:  NIL 

STARTUP 

263 

TOPLEVEL 

expr:  NIL 

STATE 

127 

MANIPULATE 

fexpr*:  L 

STATES 

NEWEXP 

Saved  Variable 
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STRENGTH 

NEWEXP 

STRIPSTREAM 

252 

STREAM 

STUFFLN 

264 

TOPLEVEL 

SUBTEND 

194 

ORACLE 

SUCCESSOR 

NEWEXP 

SUCCESSOR 

ORACLE 

SUCCESSOR 

ORACLE 

SUCCESSOR 

207 

ORACLE 

SWEEPER 

114 

INTERP 

SWR 

NEWEXP 

SWR 

ORACLE 

SWR 

ORACLE 

SWR 

204 

ORACLE 

TEKCOM 

32 

DSPLA 

TEKTEST 

33 

DSPLA 

TEKWAIT 

34 

DSPLA 

TO- PORT 

NEWEXP 

TOS 

NEWEXP 

TRACK INPOLY 

190 

ORACLE 

TWO- PLACE 

146 

MSGMTR 

TYPE 

NEWEXP 

UNCRUNCH 

17 

DSPLA 

UNFREEZE 

256 

STREAM 

UNLESSHACK 

115 

INTERP 

VAR? 

116 

INTERP 

VDRELS 

INTERP 

WAITER 

265 

TOPLEVEL 

WEATHERMSG 

147 

MSGMTR 

WELCOME 

266 

TOPLEVEL 

WENT- AFTER 

NEWEXP 

WENT-AFTER 

ORACLE 

WENT- AFTER 

ORACLE 

WENT-AFTER 

202 

ORACLE 

WENT-BEFORE 

NEWEXP 

WENT-BEFORE 

ORACLE 

WENT-BEFORE 

ORACLE 

WENT-BEFORE 

201 

ORACLE 

WHAT2FORMFN 

168 

NEWEXP 

WHATFORMFN 

169 

NEWEXP 

WHOSE2FORMFN 

170 

NEWEXP 

WITHIN-REACH 

NEWEXP 

WITHINR 

196 

ORACLE 

YESNO 

171 

NEWEXP 

carriagereturn 

NEWEXP 

if prop 

PR INFORMS 

expr 

(S) 

expr 

(MLN) 

expr 

(LAT1  LON1  LAT2 

LON2) 

ifprop 

PR INFORMS 

if prop 

ORACLE 

ifprop 

ORTYPE 

expr 

(SITE) 

expr 

(CONDITIONS 

ACTIONS 

EV) 

ifprop 

PR INFORMS 

ifprop 

ORACLE 

ifprop 

ORTYPE 

expr 

(LT1  T1  LT2 

T2) 

expr 

(STR) 

expr 

NIL 

expr 

NIL 

ifprop 

PRINFORMS 

ifprop 

PR INFORMS 

expr 

(TRACK  POLY) 

expr 

(X) 

ifprop 

PRINFORMS 

expr 

(NUM) 

expr 

NIL 

expr 

(CONDITIONS 

ACTIONS 

EV) 

expr 

(Q) 

Set  Variable 

expr 

NIL 

expr 

(TXT) 

expr 

NIL 

ifprop 

PRINFORMS 

ifprop 

ORACLE 

ifprop 

ORTYPE 

expr 

(SI  T1  S2  T2 

S3 

T3 

S4  T4) 

ifprop 

PRINFORMS 

ifprop 

ORACLE 

ifprop 

ORTYPE 

expr 

(SI  T1  S2  T2 

S3 

T3 

S4  T4) 

expr 

(PL) 

expr 

(REL  OBJ) 

expr 

(VAL  REL) 

ifprop 

PRINFORMS 

fexpr*:  L 

expr 

:  (ASSRSPEC) 

Saved  Variable 
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(PRETTYCOMPRINT  CONFIDENCECOMS) 

(RPAQQ  CONFIDENCECOMS  ( (FNS  *  CONFIDENCEFNS) 

(BLOCKS  *  CONFIDENCEBLOCKS) ) ) 


(RPAQQ  CONFIDENCEFNS  (GETCON  GETMARK  GETMB  BMEAS  BLFN  GETMD  DMEAS  DLFN 

MARKOFF  MARKON)) 


(DEFINEQ 


[11 


(GETCON 

[LAMBDA  (SOMAST)  (*  edited: 

"19-Jul-79  12:49") 

(*  GETCON  computes  the  confidence  in  an  assertion, 
which  is  defined  as  the  measure  of  belief  in  the 
assertion  less  the  measure  of  disbelief  in  the 
assertion.  GETCON  will  also  accept  a  list  of 
assertions. ) 


(COND 

((NULL  SOMAST) 

0.0) 

((ATOM  SOMAST) 

(FDIFFERENCE  (GETMB  SOMAST) 

(GETMD  SOMAST))) 

( (LISTP  SOMAST) 

( MAPCAR  SOMAST  (FUNCTION  GETCON)) 


(21 


(GETMARK 

[LAMBDA  (NODE) 

(GETPROP  NODE  (QUOTE  SUPERMARK]) 


(*  edited: 
"23-Jul-79  16:44") 


131 


(GETMB 

[LAMBDA  (BAST)  (*  edited: 

"23-Jul-79  18:36") 

(*  GETMB  calculates  the  measure  of  belief  in  an 
assertion.  If  there  is  a  derivation  tree,  the  belief 
derived  through  it  is  preferred  to  the  belief  stored 
directly  on  the  property  list 

(if  any).  GETMB  gets  the  list  of  derivation  boxes 
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and  maps  the  function  BMEAS  overthem. 

When  BMEAS  is  done,  MBCOMB  will  hold  the  measure  of 
belief  (accumulated  in  accordance  with  the  combining 
function  developed  for  MYCIN) ) 


(PROG  ( (HNDL  (GETPROP  BAST  (QUOTE  DERIVE*))) 
(MBCOMB  0.0)) 

(COND 

((EQ  (GETMARK  BAST) 

(QUOTE  POS)) 

(RETURN  0.0)) 

((EQ  (GETMARK  BAST) 

(QUOTE  NEG)) 

(RETURN  1.0)) 

(HNDL  (MAPC  HNDL  (FUNCTION  BMEAS)) 
(RETURN  MBCOMB) ) 

(T  (RETURN  (GETPROP  BAST  (QUOTE  MB)) 


[41 


( BMEAS 

[LAMBDA  (BBOX)  (*  edited: 

"24-Jul-79  13:41") 

(*  BMEAS  operates  on  a  single  derivation  box. 

If  the  box  provides  negative  evidence  it  is  ignored 
(it  will  be  counted  for  the  measure  of  disbelief). 
Otherwise  the  functions  BLFN  and  DLFN  are  mapped 
over  the  assertion  entries  in  the  box. 

This  results  in  BMEAS ANS  being  set  to  the  minimum  of 
the  belief  measures  for  each  assertion  in  the  box, 
while  DMEASANS  is  set  to  the  maximum  of  the 
disbelief  measures.  The  difference  between  BMEAS ANS 
and  DMEASANS,  if  positive,  is  multiplied  by  the  rule 
confidence  and  combined  with  the  measures  produced 
by  the  other  boxes.  If  the  difference  is  negative, 
this  box  is  ignored.) 


(PROG  ((BASTLST  (CDR  BBOX)) 

(RULECON  (GETPROP  (CAR  BBOX) 

(QUOTE  CONF) ) ) 

(BMEAS ANS  1.0) 

(DMEASANS  0.0)) 

(COND 

( (MINUSP  RULECON) 

(RETURN) ) ) 


(RESETLST  [RESETSAVE  (MARKON  BAST  (QUOTE  POS))  I 

(QUOTE  (AND  (MARKOFF  BAST]  I 

(MAPC  BASTLST  (FUNCTION  BLFN))  I 

(MAPC  BASTLST  (FUNCTION  DLFN)))  I 

(COND 

( (FGREATERP  BMEASANS  DMEASANS) 


(SETQ  BMEASANS  (FTIMES  RULECON  (FDIFFERENCE  BMEASANS 

DMEASANS) ) ) 

(SETQ  MBCOMB  (FDIFFERENCE  (FPLUS  BMEASANS  MBCOMB) 


L 

l _ 
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(FTIMES  BMEASANS  MBCOMB] ) 

[5] 


(BLFN 

[LAMBDA  (BNODE)  (*  edited: 

"23-Jul-79  18:38") 

(*  BLFN  looks  at  a  single  node  contained  in  a 
derivation  box.  If  the  node  is  satisfying  a  negation 
condition,  the  measure  of  belief  for  use  in 
confidence  calculation  is  taken  to  be  the  measure  of 
disbelief  in  the  assertion.  If  the  node  is 
satisfying  an  unless  condition,  the  measure  of 
belief  used  is  1.0  if  the  confidence  in  the  node  is 
0.0  or  less,  otherwise  the  measure  of  belief  is 
zero.  For  AND  and  OR  conditions,  BLFN  just  uses  the 
measure  of  belief  in  the  assertion. 

Having  acquired  a  usable  measure  of  belief,  BLFN 
then  tests  this  against  BMEASANS 

(the  minimal  MB  to  this  point) ,  and  sets  BMEASANS  to 
the  minimum  of  these  two.) 


(PROG  ( (BNCON  0.0))  (*  This  sets  up  BNCON 

with  a  floating  number 
box) 

ICOND 

( (LISTP  BNODE) 

(SELECTQ  (CAR  BNODE) 

[NOT  (SETQ  BNCON  (GETMD  (CADR  BNODE]  I 

[UNLESS  CPROGN  (SETQ  BNCON  (GETCON  (CADR  BNODE))) 
(COND 

((GREATERP  BNCON  0.0) 


(SETQ  BNCON  0.0))  I 

(T  (SETQ  BNCON  1.0]  I 

(SETQ  BNCON  0.0) ) )  I 

(T  (SETQ  BNCON  (GETMB  BNODE]  I 

(SETQ  BMEASANS  (MIN  BNCON  BMEASANS]) 


[6] 

(GETMD 

[LAMBDA  (DAST)  (*  edited: 

"23-JU1-79  18:39") 

(*  GETMD  corresponds  to  GETMB  for  measures  of 
disbelief.  It's  used  the  same  way,  but  calls  its  own 
subsidiary  functions,  DMEAS  and  DLFN . ) 


(PROG  ( (DNDL  (GETPROP  DAST  (QUOTE  DERIVE*))) 
( MDCOMB  0.0)) 

(COND 

(<EQ  (GETMARK  DAST) 

(QUOTE  POS)) 

(RETURN  1.0)) 
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((EQ  (GETMARK  DAST) 

(QUOTE  NEG) ) 

(RETURN  0.0)) 

(DNDL  (MAPC  DNDL  (FUNCTION  DMEAS) ) 
(RETURN  MDCOMB) ) 

(T  (RETURN  (GETPROP  DAST  (QUOTE  MD] ) 


17] 


(DMEAS 

[LAMBDA  (DBOX)  (*  edited: 

"24-Jul-79  13:44") 

(*  See  BMEAS  for  a 
description.  Substitute 
DLFN  for  BLFN,  etc.) 

(PROG  ((DASTLST  (CDR  DBOX)) 

(RULECON  (GETPROP  (CAR  DBOX) 

(QUOTE  CONF) ) ) 

( BMEAS ANS  1.0) 

( DMEAS ANS  0.0)) 

(COND 

((NOT  (MINUSP  RULECON)) 

(RETURN) ) ) 

(RESETLST  [RESETSAVE  (MARKON  DAST  (QUOTE  NEG) )  I 

(QUOTE  (AND  (MARKOFF  DAST]  I 

(MAPC  DASTLST  (FUNCTION  BLFN) )  I 

(MAPC  DASTLST  (FUNCTION  DLFN)))  I 

(COND 

( ( FGREATERP  BMEASANS  DMEAS ANS) 

(SETQ  DMEAS ANS  (FTIMES  RULECON  (FDIFFERENCE  DMEAS ANS 

BMEASANS) ) ) 

(*  Negative  by  negative 
gives  positive) 

(SETQ  MDCOMB  (FDIFFERENCE  (FPLUS  DMEASANS  MDCOMB) 

(FTIMES  DMEASANS  MDCOMB]) 


[8] 

(DLFN 

[LAMBDA  (DNODE)  (*  edited: 

"23-Jul-79  18:41") 

(*  See  BLFN  for  a 
description  of  the 
actions. ) 

(PROG  ( (DNCON  0.0)) 

[COND 

( (LISTP  DNODE) 

(SELECTQ  (CAR  DNODE) 

[NOT  (SETQ  DNCON  (GETMB  (CADR  DNODE]  I 

[UNLESS  (PROGN  (SETQ  DNCON  (GETCON  (CADR  DNODE))) 
(COND 

((FGREATERP  DNCON  0.0) 


(SETQ  DNCON  1.0))  I 

(T  (SETQ  DNCON  0.0]  I 

(SETQ  DNCON  0.0)))  I 

(T  (SETQ  DNCON  (GETMD  DNODE]  I 

(SETQ  DMEASANS  (MAX  DNCON  DMEASANS]) 
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(91 


(MARKOFF 

(LAMBDA  (NODE) 

(REMPROP  NODE  (QUOTE  SUPERMARK]) 


(*  edited: 
"23-Jul-79  16:44") 


(10] 


(MARKON 

[LAMBDA  (NODE  MARK) 


) 


(PUTPROP  NODE  (QUOTE  SUPERMARK) 
MARK]) 


(*  edited: 
"23-JU1-79  16:43") 


( RPAQQ  CONFIDENCEBLOCKS  ( (CONFIDEBLOCK  GETCON  GETMB  BMEAS  BLFN  GETMD 

DMEAS  DLFN 

(ENTRIES  GETCON  GETMB  BMEAS  BLFN 
GETMD  DMEAS  DLFN) 
(SPECVARS  MBCOMB  BAST  BMEAS ANS 

MDCOMB  DAST  DMEAS ANS) ) ) 

) 

[DECLARE:  DONTEVAL@LOAD  DOEVAL0COMPILE  DONTCOPY 
(BLOCK:  CONFIDEBLOCK  GETCON  GETMB  BMEAS  BLFN  GETMD  DMEAS  DLFN 
(ENTRIES  GETCON  GETMB  BMEAS  BLFN  GETMD  DMEAS  DLFN) 

(SPECVARS  MBCOMB  BAST  BMEAS ANS  MDCOMB  DAST  DMEAS ANS) ) 

] 

(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (399  7481  (GETCON  411  .  923)  (GETMARK  927  .  1060)  (GETMB 
1064  .  2079)  (BMEAS  2083  .  3494)  (BLFN  3498  .  4851)  (GETMD  4855  .  5573) 
(DMEAS  5577  .  6526)  (DLFN  6530  .  7192)  (MARKOFF  7196  .  7329)  (MARKON 
7333  .  7478))))) 

STOP 
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changes  to:  TEKTEST 

previous  date:  "  l-Aug-79  18:01:40"  <PM0RR1S>DSPLA.LSP.87) 


PRETTYCOMPRINT  DSPLACOMS) 

RPAQQ  DSPLACOMS  [ (FNS  *  DSPLAFNS) 

(DECLARE:  DONTEVAL8LOAD  DOEVAL0COMPILE  DONTCOPY  COMPILERVARS 
(ADDVARS  (NLAMA  M) 

(NLAML  FKVALAT) 

(LAMA) ) ) 

(VARS  (SCRATCHTEN  (QUOTE  (0000000000))) 

(SCRATCHFIVE  (QUOTE  (0  0  0  0  0))) 

(DSPEXCHBUF  (CONCAT 

n  it 

(CHARACTER  0))) 

(DSPEXCHEMP  (CONCAT 
"EMPTY 

(CHARACTER  0]) 

(RPAQQ  DSPLAFNS  (GRATEK  M  MONTEK  DSPCMD  DSPINIT  PRINCHAR  UNCRUNCH 

CRUNCH  DSPCNVRT  DSPNUMAT  FKVALAT  DSPADDTRH 
DSPADDINC  DSPGRAB  DSPRELD  DSPTTY  DSPQUIET 
BKDSPBUF  DECS AMEDIG ITS  OCTSAMEDIGITS  DSPTTYSTR 
TEKCOM  TEKTEST  TEKWAIT  DSPERASE  DSPEXCH  DSPMAP 
DSPNOMAP  DSPTOP  DSPSTAT  DSPADDINCS  DSPCHGTRH 
DSPSAVE) ) 

(DEFINEQ 

[11] 

(GRATEK 

[LAMBDA  NIL  (*  edited: 

"  1 -Aug-79  17:48") 

(TEKCOM  "WOR  33  H") 

(TEKCOM  "GRA  3,33") 

(TEKCOM  "SHR  B") 

(PRINCHAR  29) 

(PRIN1  "BONE") 

( JSYS  60  31) 

(PRINCHAR  27) 

(PRINCHAR  12) 

(TERPRI) 

(DOBEJ ) 

[121 


(NLAMBDA  L 

( NCONC  DSPLAFNS  L)  I 

(MAKEFILE  (QUOTE  DSPLA.LSP]) 
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(MONTEK 

[LAMBDA  NIL 

(TEKCOM  "MON  34"J) 


(*  edited: 
"30-JU1-79  19:31") 


[14] 


(DSPCMD 

[LAMBDA  (CMD  WAITFLG)  (*  edited: 

"30-JU1-79  16:03") 

(PROG  (DSPNOWAITFLG) 

(FKCALL  ERASE  SUBR) ) 

(COND 

(TEK4025  (GRATEK))) 

(PROG  ((DSPNOWAITFLG  T) ) 

ICOND 

((OR  WAITFLG  (EQP  DSPTTYCODE  262143)) 

(SETQ  DSPNOWAITFLG  (GETTOPVAL  (QUOTE  DSPNOWAITFLG] 
(FKCALL  DSPLA  SUBR  CMD  (NCHARS  CMD)) 

(TERPRI) ) 

(COND 

(TEK4025  (MONTEK]) 


[151 

(DSPINIT 

(LAMBDA  NIL  I 

(SETQ  DSPNOWAITFLG  NIL)  I 

(FKINIT  DSPLIB)  I 

(DSPQUIET)  I 

(BKDSPBUF  "1.3 

1.0 

NO 

")  I 

(*  THIS  "UNREADS"  THE  STRING,  IE.  I 

PLACES  IT  IN  THE  DISPLAY  INPUT  BUFFER,  SO  THAT  IT  I 

WILL  BE  READ  BY  THE  FORTRAN  SUBROUTINE  DSPLAI)  I 

(DSPCNVRT  (DSPTTYSTR) )  I 

(FKSETVAL  NTTY  1  (LIST  DSPWORDl  DSPWORD2) )  I 

(FKCALL  FRTEND  SUBR)  I 

(DSPTTY)  I 

(TERPRI] ) 


[16] 


(PR INCHAR 

(LAMBDA  (CODE) 

(RESETFORM  ((LAMBDA  (X) 

(ECHOCONTROL  CODE  X] 
(QUOTE  REAL)) 

(PRINl  (CHARACTER  CODE]) 


(*  edited: 
"31-Jul-79  20:03") 
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[171 


(UNCRUNCH 

[LAMBDA  (NUM)  I 

(PROG  ( (PTR  SCRATCHFIVE) )  (*  CONVERTS  A  SINGLE  I 

WORD  TO  A  LIST  OF  FIVE  I 

CHAR  CODES)  I 

(*  Reuses  a  scratch  list 
for  efficiency)  I 

[RPTQ  5  (PROGN  ( RPLACA  PTR  (LRSH  NUM  29))  I 

(SETN  NUM  (LLSH  NUM  7))  I 

(SETQ  PTR  (CDR  PTR]  I 

(RETURN  SCRATCHFIVE]) 

(18] 

(CRUNCH 

[LAMBDA  (X) 

(PROG  ((NUM  0))  (*  CONVERTS  A  LIST  OF 

FIVE  CHAR  CODES  TO  A 
SINGLE  WORD)  I 

I 

(*  If  the  list  is  less  than  5  chars  the  extra  I 

positions  are  filled  with  blanks  I 

(ASCII  32))  I 


[RPTQ  5  (PROGN  (SETN  NUM  (LOGOR  (LLSH  NUM  7)  I 

(OR  (CAR  X)  I 

32)))  I 

(SETQ  X  (CDR  X]  I 

(RETURN  (LLSH  NUM  11) 

[191 

(DSPCNVRT 

[LAMBDA  (X)  i 

(*  Converts  an  atom  or  string  of  up  to  10  characters  I 

into  2  integers  corresponding  to  the  FORTRAN  I 

representation  of  the  chars.  ~~  I 

Pads  right  with  blanks.  Returns  values  bound  to  I 

DSPWORD1  and  DSPWORD2.)  I 


(SETQ  X  (DCHCON  X  SCRATCHTEN) )  I 

(SETQ  DSPWORD2  (CRUNCH  (NTH  X  6) ) )  I 

(SETQ  DSPWORD1  (CRUNCH  X]) 

[20] 

(DSPNUMAT 
[LAMBDA  (X) 

(COND 

( (LISTP  X) 

(MAPCAR  X  (FUNCTION  DSPNUMAT))) 
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(T  ( PACKC  (UNCRUNCH  X] ) 


[21] 


( FKVALAT 

[ NLAMBDA  (ID  BIAS  NVALS) 

(DSPNUMAT  (APPLY  (FUNCTION  FKVALI) 

(LIST  ID  BIAS  NVALS]) 


[221 


(DSPADDTRH 

[LAMBDA  (NAME  ID  TYPE)  (*  NOBIND  I 

"12-Dec-78  17:30")  I 

(DSPCNVRT  NAME)  (*  DSPCNVRT  returns  I 

output  bound  to  DSPWORD1 
and  DSPWORD2)  I 

(FKCALL  DSPTRH  SUBR  DSPWORD1  DSPWORD2  (DSPCNVRT  ID)  '  I 

(DSPCNVRT  TYPE]) 

(231 

(DSPADDINC 

[LAMBDA  (NAME  LAT  LON  TIME)  | 

(DSPCNVRT  NAME)  | 

(FKCALL  DSPINC  SUBR  DSPWORD1  DSPWORD2  LAT  LON  TIME]) 

[241 

(DSPGRAB 

[LAMBDA  (TTYNO) 

(NEQ  1  (COND  | 

(TTYNO  (SETQ  DSPTTYCODE  (IPLUS  400000Q  (OCTSAMEDIGITS  TTYNO)) 

)  I 

(FKJSYS  70Q  DSPTTYCODE))  | 

(T  (SETQ  DSPTTYCODE  777777Q] ) 

[25] 

(DSPRELD 

[LAMBDA  NIL  | 

(FKJSYS  57  DSPTTYCODE]) 

[26] 


(DSPTTY 

[LAMBDA  NIL 

(FKJSYS  135  (CAR  FORKDATA) 

(LOGOR  (LLSH  DSPTTYCODE  18) 
DSPTTYCODE) ) 

(FKCALL  OLDMOD  SUBR]) 


[271 

(DSPQUIET 
[LAMBDA  NIL 

(FKJSYS  135  (CAR  FORKDATA) 
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(LOGOR  (LLSH  DSPTTYCODE  18) 
131071) ) 

( FKCALL  DSPMOD  SUBR] ) 


[28] 


(BKDSPBUF 
[LAMBDA  (X) 

(MAPC  (CHCON  X) 

(FUNCTION  (LAMBDA  (C) 

(FKJSYS  76  DSPTTYCODE  (COND  I 

((EQ  C  31)  I 

13)  I 

(T  cn 

[291 


(DECSAMEDIGITS 

[LAMBDA  (X)  (*  Converts  an  octal 

number  to  a  decimal  with 
the  same  digits) 

(COND 

( (LESSP  X  8) 

X) 

(T  (IPLUS  (IREMAINDER  X  8) 

( ITIMES  10  (DECSAMEDIGITS  ( IQUOTIENT  X  8]) 

[30] 

(OCTSAMEDIGITS 
[LAMBDA  (X) 

(*  Converts  a  decimal  number,  all  of  whose  digits 
are  less  than  eight,  to  an  octal  number  having  the 
same  digits) 


(COND 

((LESSP  X  12Q) 

X) 

(T  (IPLUS  (IREMAINDER  X  12Q) 

(ITIMES  10Q  (OCTSAMEDIGITS  (IQUOTIENT  X  12Q] ) 

[31] 

(DSPTTYSTR 
[LAMBDA  NIL 

(CONCAT  "TTY"  [COND  I 

( (EQP  DSPTTYCODE  262143)  I 

"")  I 

(T  (DECSAMEDIGITS  ( IDIFFERENCE  DSPTTYCODE  131072]  I 

":"]) 
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( TEKCOM 

[LAMBDA  (STR) 

(PR INI  TEKCOMCHAR) 
(PRIN1  STR) 
(TERPRI1) 


(TEKTEST 

[LAMBDA  NIL 

(PROG  (UTEKFLG) 

(CLEARBUP) 

(PRINCHAR  27) 

(PRINCHAR  5) 

(TERPRI) 

(DISMISS  2000) 

(SETQ  TEKFLG  (READP  T) ) 

(CLEARBUF) 

(PRINl  "Ate  you  running  on  a  Tektronix?")  I 

(SETQ  UTEKFLG  (EQ  (ASKUSER)  I 

(QUOTE  Y)))  I 

(SETQ  TEK4025  NIL)  I 

[COND  I 

((AND  UTEKFLG  (NOT  TEKFLG))  I 

(PRINl  "TEK4025?  ")  I 

(SETQ  TEK4025  (EQ  (ASKUSER)  I 

(QUOTE  Y>))  I 

(COND  I 

(TEK4025  (PRINl  I 

"Please  type  TEK4025  command  character:  ")  I 
(SETQ  TEKCOMCHAR  (READ))  I 

(CLEARBUFJ  I 

(RETURN  (SETQ  TEKFLG  UTEKFLG 1 ) 

[341 

(TEKWAIT 

[LAMBDA  NIL  (*  edited: 

"  9-Feb-79  16:51") 

(COND  I 

(TEKFLG  ( JSYS  68  DSPTTYCODEJ ) 

[35] 


(DSPERASE 

[LAMBDA  NIL  (*  NOBIND 

"18-Dec-78  17:32") 

(FKCALL  ERASE  SUBR) 

(TEKWAIT] ) 
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[32] 

(*  edited: 

"30-JU1-79  19:06") 


[33] 


(*  edited: 
"10-Aug-79  16:19") 


Afr. . 


ESUSMffii. 


!isi.-aste 
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[361 


(DSPEXCH 

[LAMBDA  (NAME) 

(RPTQ  10  (RPLSTRING  DSPEXCHBUF  (ADD1  (ITIMES  RPTN  5)) 

(OR  (NTHCHAR  NAME  RPTN)  I 

"  ")))  I 

(FKCALL  DSPLAX  SUBR  DSPEXCHBUF]) 

[371 


(DSPMAP 

[LAMBDA  NIL 

(COND  I 

((INFILEP  (QUOTE  HGHRES.MER) )  I 

(FKSETVAL  FLAGS  3  (DSPCNVRT  "MAP")))  i 

(T  (PRIN1  "File  missing:  HGHRES.MER  —  Map  not  available")  I 

(TERPRU  ) 


[381 


(DSPNOMAP 
[LAMBDA  NIL 

(FKSETVAL  FLAGS  3  (DSPCNVRT  "NOMAP"]) 


[391 


(DSPTOP 

[LAMBDA 

(PROG 


(WAITFLG)  (*  edited: 

"31-Jul-79  21:04") 

( (DSPNOWAITFLG  T) 

FIRSTCMD) 

[COND 

((OR  WAITFLG  (EQP  DSPTTYCODE  262143)) 

(SETQ  DSPNOWAITFLG  (GETTOPVAL  (QUOTE  DSPNOWAITFLG) 
(RESETLST  [COND 

(TEK4025  (RESETSAVE  (GRATEK) 

(QUOTE  (MONTEK] 

(FKCALL  DSPTOP  SUBR]) 


(40) 


(DSPSTAT 

[LAMBDA  NIL 

(FKJSYS  156Q  (CAR  FORKDATA) ) 
(LRSH  FKJSYSAC1  22Q] ) 


[411 


(DSPADDINCS 

[LAMBDA  (NAME  INCLST) 

(DSPCNVRT  NAME) 

(MAPC  INCLST  (FUNCTION  (LAMBDA  (INC) 

(FKCALL  DSPINC  SUBR  DSPWORD1  DSPWORD2  (CAR  INC) 
(CADR  INC) 

(CADDR  INC]) 
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(DSPCHGTRH 

[LAMBDA  (NAME  ID  TYPE) 

(DSPQUIET) 

(DSPEXCH  NAME) 

(AND  ID  (FKSETVAL  CLOC  26  (DSPCNVRT  ID))) 

(AND  TYPE  (FKSETVAL  CLOC  27  (DSPCNVRT  TYPE))) 
( FKCALL  DSPLAX  SUBR  DSPEXCHEMP) 

(DSPTTYl ) 


[431 


(DSPSAVE 

[LAMBDA  NIL  (*  NOBIND 

"20-Dec-78  11:57") 

(FKCALL  DREL  SUBR) 

(DSPRELD) 

(PROG1  (FKSAVE  (QUOTE  DSPLIB.EXE))  I 

(FKKILLl ) 

) 

(DECLARE:  DONTEVAL0LOAD  DOEVAL8COMPILE  DONTCOPY  COMPILERVARS 

( ADDTOVAR  NLAMA  M) 

(ADDTOVAR  NLAML  FKVALAT) 

(ADDTOVAR  LAMA  ) 

) 


( RPAQQ  SCRATCHTEN  (0000000000)) 

( RPAQQ  SCRATCHFIVE  (00000)) 

(RPAQ  DSPEXCHBUF  (CONCAT 

n  n 

(CHARACTER  0))) 

(RPAQ  DSPEXCHEMP  (CONCAT 

"EMPTY  " 

(CHARACTER  0))) 

(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (1012  9856  (GRATEK  1024  .  1312)  (M  1316  .  1404)  (MONTEK 
1408  .  1526)  (DSPCMD  1530  .  2019)  (DSPINIT  2023  .  2635)  (PRINCHAR  2639  . 

2843)  (UNCRUNCH  2847  .  3303)  (CRUNCH  3307  .  3848)  (DSPCNVRT  3852  .  4357 
)  (DSPNUMAT  4361  .  4479)  (FKVALAT  4483  .  4589)  (DSPADDTRH  4593  .  4930)  ( 
DSPADDINC  4934  .  5081)  (DSPGRAB  5085  .  5310)  (DSPRELD  5314  .  5381)  ( 
DSPTTY  5385  .  5519)  (DSPQUIET  5523  .  5655)  (BKDSPBUF  5659  .  5838)  ( 
DECSAMEDIG ITS  5842  .  6099)  (OCTSAMEDIGITS  6103  .  6396)  (DSPTTYSTR  6400  . 
6609)  (TEKCOM  6613  .  6763)  (TEKTEST  6767  .  7771)  (TEKWAIT  7775  .  7933) 
(DSPERASE  7937  .  8073)  (DSPEXCH  8077  .  8266)  (DSPMAP  8270  .  8504)  ( 
DSPNOMAP  8508  .  8575)  (DSPTOP  8579  .  9047)  (DSPSTAT  9051  .  9162)  ( 
DSPADDINCS  9166  .  9423)  (DSPCHGTRH  9427  .  9649)  (DSPSAVE  9653  .  9853)))) 
) 

STOP 
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changes  to:  FORKCOMS 

previous  date:  "29-NOV-78  17:47:22"  <PMORRIS>FORK.LSP.18) 


(PRETTYCOMPRINT  FORKCOMS) 

( RPAQQ  FORKCOMS  I (VARS  (DSPNOWAITFLG  NIL)) 

(FNS  *  FORKFNS) 

[ ADDVARS  (GLOBALVARS  FORKDATA  DSPNOWAITFLG) 

(AFTERSYSOUTFORMS  (PROGN  ( RPLACA  FORKDATA  NIL) 

(FKKILL) 

(P  (AND  (EQ  (EVALV  (QUOTE  FORKDATA)) 

(QUOTE  NOBIND) ) 

(SETQ  FORKDATA  NIL))) 

(PROP  MACRO  FKIDPB  FKRACS  FKSACS  PUTTYP  FKHNDL  FKHT  FKSHR 
FKSYMACS  FKDDT  FKJFN  FKHT_  FKDDT_  FKPROG  FKHALT) 

(BLOCKS  *  FORKBLOCKS) 

(DECLARE:  DONTEVAL@LOAD  DO EVAL0 COMPILE  DONTCOPY  COMPILERVARS 
(ADDVARS  (NLAMA  SAILCALL  FKCALL) 

( NLAML  FKSETVAL  FKVALI  FKVALR  FKVAL  FKSETA 
FKELTR  FKELTI  FKELT  FKARRAY  FKX 
FKINIT] ) 


(RPAQ  DSPNOWAITFLG  NIL) 

(RPAQQ  FORKFNS  (FKINIT  FKKILL  FKSAVE  FKDDT  FKCALL  FKCATYPE  FKSR 

SAILCALL  SAILARG  SAILSTRING  FKACS  FKACSRETURN 
FKRTN  NOFORK  FKCALLERR  FKSW  FKX  FKTTYSET  FKARRAY 
FKCORGET  FKELT  FKELTI  FKELTR  FKSETA  FKARRAYP 
FKARRAYSIZE  SAILARRAYSIZE  FKARRAYTYPE  FKBCHECK 
FKARRADR  FKFLOAT  ARRLOC  FKVAL  FKVALR  FKVALI 
FKSETVAL  FKSYM  FKSYMPUT  FKSYMP  GETRADIX50  FKTIME 
FKJSYS  FKJSYSARG  FKWAIT) ) 

(DEFINEQ 


[441 


(FKINIT 

[NLAMBDA  (PROGRAM) 

(PROG  ((FKACS  (ARRAY  20Q  20Q) )  I 

(FKHT  (HARRAY  62Q) )  I 

(FKSYMACS  (ARRAY  20Q  20Q) )  I 

FKSHR  FKJFN  FKDDT  FKHNDL  PGS  PROGFILE  HALTADR  HALTED  EV)  I 


(SETQ  PROGFILE 

(OR  (INFILEP  PROGRAM) 

(AND  (NOT  (MEMBER  (QUOTE  %.) 

(UNPACK  PROGRAM))) 

(INFILEP  (PACK  (LIST  PROGRAM  (QUOTE  .EXE] 
(ERROR  PROGRAM  "  FILE  NOT  FOUND"))) 

(AND  (EQP  (FKJSYS  20Q  100001000000Q  (MKSTRING  PROGFILE)) 

1) 

(ERROR  PROGRAM  "  —  GTJFN  FAILED")) 

(SETQ  FKJFN  FKJSYSAC1) 
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(COND 

( (EQP  (FKJSYS  152Q  200000000000Q) 

1) 

(FKJSYS  23Q  FKJFN) 

(ERROR  PROGRAM  "  —  CANNOT  CREATE 
(SETQ  FKHNDL  FKJSYSAC1) 

(FKJSYS  20 OQ  (LOGOR  (LLSH  FKHNDL  22Q) 

FKJFN) ) 

(FKJSYS  205Q  FKHNDL) 

(SETQ  HALTED  (LRSH  FKJSYSAC2  22Q) ) 

[COND 

((OR  (ILESSP  HALTED  5) 

( IGREATERP  HALTED  17Q) ) 

(FKSW  FKHNDL  124Q) 

(FKJSYS  205Q  FKHNDL) 

(SETQ  HALTED  (LRSH  FKJSYSAC2  22Q) ) 

(*  GEVEC  AGAIN) 

(COND 

((OR  (ILESSP  HALTED  5) 

(IGREATERP  HALTED  17Q) ) 

(ERROR  PROGRAM  "  --  UNABLE  TO  INITIALIZE  LOWER  FORK"] 
(SETQ  EV  FKJSYSAC2) 

(SETQ  HALTED  (RESETFORM  (FKTTYSET  (QUOTE  INITIAL) ) 

(FKSW  FKHNDL  3))) 

(*  START  THE  FORK) 

(FKJSYS  204Q  FKHNDL  EV) 

(FKRACS  FKHNDL  FKACS) 

(SETQ  HALTADR  (ADD1  (ELT  FKACS  3))) 

(OR  (EQP  HALTED  HALTADR) 

(ERROR  PROGRAM  "  —  INITIALIZATION  UNSUCCESSFUL")) 

(SETQ  PGS  (ELT  FKACS  2))  (*  NUMBER  OF  PAGES  TO 

SHARE) 

(AND  (IGREATERP  PGS  144Q) 

(ERROR  PROGRAM  "  ATTEMPT  TO  SHARE  TOO  MANY  PAGES")) 

[AND  (IGREATERP  PGS  0) 

(PROG  ((LISPBLOCK  (LOC  (GETBLK  PGS))) 

(SIZE  (LLSH  PGS  11Q) ) 

SOURCE  DEST) 

[SETQ  SOURCE  (SUB1  (LOGOR  -400000000000Q 

(LRSH  LISPBLOCK  11Q] 

[SETQ  DEST  (SUB1  (LOGOR  (LLSH  FKHNDL  22Q) 

(ELT  FKACS  1) 

(RPTQ  PGS  (FKJSYS  56Q  (IPLUS  SOURCE  RPTN) 

(IPLUS  DEST  RPTN) 

160000000000Q) ) 

(RETURN  (SETQ  FKSHR 
(LIST  SIZE 

( IDIFFERENCE  (LLSH  (ELT  FKACS  1) 

11Q) 

LISPBLOCK) 

(IPLUS  LISPBLOCK  SIZE) 

LISPBLOCK] 

(SETQ  FORKDATA  (LIST  FKHNDL  (LIST  FKHT  HALTADR) 

(LIST  FKACS) 

FKSHR  FKSYMACS  FKDDT  FKJFN  PROGFILE) ) 


(*  FAILED  TO  CREATE 
FORKNAME) 

(*  RELEASE  FKJFN) 
FORK") ) ) 


(*  GET) 

(*  GEVEC) 

(*  HALTED  IS  A  TEMPORARY 
VARIABLE  HERE) 


(*  REENTER) 
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(*  FORKDATA  IS  SET  TO  A  LIST  OF  THE  FOLLOWING  - 
FKHNDL  :  The  fork  handle  - 

FKHT  :  Hash  table  of  fork  symbols  and  names  of 
shared  arrays  (values  are  fork  addresses)  - 
FKHALT  s  Expected  PC  of  fork  termination  - 
FKJFN  :  JFN  of  program  in  the  fork  - 
FKACS  :  List  of  arrays  used  to  hold  acs  for  fork  - 
FKSHR  :  List  containing  information  about  shared 
pages,  format  is  (words-left  conversion  ending 
start)  where  words-left  is  the  number  of  unallocated 
words  remaining  in  the  shared  pages,  conversion  is 
the  factor  to  be  added  to  lisp  address  to  get  the 
fork  address  of  the  first  word  of  the  array,  ending 
is  the  lisp  address  of  the  word  after  the  block  of 
shared  pages,  and  start  is  the  lisp  address  of  the 
first  word  of  the  block  - 

FKSYMACS  :  Another  AC  array  for  use  by  FKSYMGET  - 
FKDDT  :  The  FKJFN  for  DDT  in  the  fork.) 


(RETURN  PROGFILEl ) 


(451 


(FKKILL 

[LAMBDA  NIL 

(PROG  (DDT  SHR  FKPROG) 

(SELECTQ  (EVALV  (QUOTE  FORKDATA)) 

(NIL  (RETURN  NIL)) 

(NOBIND  (RETURN  (SETQ  FORKDATA  NIL))) 
NIL) 

(COND 

[(FKHNDL  FORKDATA) 

(FKJSYS  156Q  (FKHNDL  FORKDATA))  (*  RFSTS) 
(COND 

( (EQP  (RSH  FKJSYSAC1  22Q) 

-1) 

(SETQ  FKPROG  NIL)) 

(T  (SETQ  FKPROG  (FKPROG  FORKDATA)) 

(FKJSYS  153Q  (FKHNDL  FORKDATA)) 

(*  KFORK) 

(FKJSYS  23Q  (FKJFN  FORKDATA)) 

(*  RLJFN) 

(SETQ  DDT  (FKDDT  FORKDATA)) 

(AND  DDT  (FKJSYS  23Q  DDT))  (*  RLJFN) 

] 

(T  (SETQ  FKPROG  NIL))) 

(SETQ  SHR  (CDDR  (FKSHR  FORKDATA))) 

(AND  SHR  (RELBLK  (VAG  (CADR  SHR)) 

(LRSH  ( IDIFFERENCE  (CAR  SHR) 

(CADR  SHR)) 

11Q) ) ) 

(SETQ  FORKDATA  NIL) 

(RETURN  FKPROG]) 
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(FKSAVE 

[LAMBDA  (FILE)  (*  SAVE  A  FORK  FILE  ON 

THE  DISK) 

(PROG  ( JFN) 

(OR  (EQ  2  (FKJSYS  20Q  -377777000000Q  (MKSTRING  FILE))) 

(ERROR  FILE  "  --  GTJFN  FAILED")) 

(SETQ  JFN  FKJSYSAC1) 

(FKJSYS  202Q  (LOGOR  (LLSH  (FKHNDL  FORKDATA) 

22Q) 

JFN) 

-17777760Q) 

(RETURN  (INFILEP  FILE]) 


(FKDDT 

[LAMBDA  (DDTFILE) 

(PROG  (FKHNDL) 

(OR  FORKDATA  (NOFORK)) 

(SETQ  FKHNDL  (FKHNDL  FORKDATA)) 

[OR 

(FKDDT  FORKDATA  (*  THE  MACRO  FKDDT)) 

(PROGN 

(FKJSYS  47  (LOGOR  (LLSH  FKHNDL  18) 

504))  (*  CHECK  IF  DDT  WAS 

SAVED  WITH  THE  FORK) 

(AND  (ZEROP  (LOGAND  FKJSYSAC2  1073741824)) 

(PROG  (DDT  EV) 

(FKJSYS  133  FKHNDL)  (*  SAVE  ENTRY  VECTOR 

WORD  BEFORE  DO  GET  FOR 
DDT) 

(SETQ  EV  FKJSYSAC2) 

(AND  (EQP  (FKJSYS  16  8590196736 

(COND 

(DDTFILE  (MKSTRING  DDTFILE) 
) 

(T  "<SUBSYS>IDDT. EXE") ) ) 

1) 

(ERROR  ""  "CANNOT  GET  JFN  FOR  DDT")) 

(SETQ  DDT  FKJSYSAC1) 

(FKJSYS  128  (LOGOR  (LLSH  FKHNDL  18) 

DDT) ) 

(FKJSYS  132  FKHNDL  EV) 

(*  RESTORE  OLD  ENTRY 
VECTOR) 

(FKDDT_  FORKDATA  DDT) 

(RETURN  (FKSW  FKHNDL  6)) 

(*  SET  UP  $1-1  IN  THE 
FORK) 

] 

(RESETFORM  (FKTTYSET  T) 

(FKSW  FKHNDL  258048))  (*  START  FORK  AT  DDT 

ENTRY  WAIT  FOR  FORK  TO 
HALT) 


(RETURN  Tl) 
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( FKCALL 

INLAMBDA  FKCX  (*  NOBIND 

"24-Nov-78  13:35") 

(PROG  (FKCBP  FKCARG  FKCTYPE  FKCVAL  FKCWRDS  FKCABP  FKHNDL  FKHT  FKCA 
FKCRESLIST  (FKCID  (CAR  FKCX)) 

FKBIAS  FKRESULT  (FKRESULTYPE  (CADR  FKCX)) 

( FKCARG S  (CDDR  FKCX)) 

(FKCN  3)) 

(OR  FORKDATA  (NOFORK) ) 

(SETQ  FKHNDL  (FKHNDL  FORKDATA)) 

(SETQ  FKHT  (FKHT  FORKDATA)) 

(SETQ  FKCA  (FKACS) ) 

(SETQ  FKCBP  (LOGOR  -30014439424  (IPLUS  (LOC  FKCA) 

2))) 

(*  3  BIT  BYTE  POINTER  TO 
TYPE  BITS) 

(SETQ  FKCABP  (LOGOR  -29460791296  (IPLUS  (LOC  FKCA) 

3))) 

(*  FULL  WORD  BYTE 
POINTER  TO  FKCA+3) 

(FKWAIT  FKHNDL)  I 

(AND  (LISTP  FKCID) 

(SETQ  FKCID  (EVAL  FKCID))) 

(FKIDPB  (FKSYM  FKCID  FKHT) 

FKCABP  (*  STORE  THE  ADDRESS  OF 

THE  SUBPROGRAM  IN  FKCA 
(2)  ) 

) 


ARGLOOP 

(OR  FKCARG S  (GO  ARGDONE) ) 

(SETQ  FKCARG  (CAR  FKCARG S) ) 

(AND  (LISTP  FKCARG) 

(SELECTQ  (CAR  FKCARG) 

(BIAS  (SETQ  FKBIAS  (EVAL  (CADR  FKCARG))) 
(SETQ  FKCTYPE  (FKCATYPE  FKBIAS)) 

[SETQ  FKCARG 

(IPLUS  (FKSYM  FKBIAS  FKHT) 

(SUB1  (EVAL  (CADDR  FKCARG] 
(GO  PUTARG)) 

((INTEGER  REAL  LOGICAL) 

(SETQ  FKCRESLIST  (CONS  (CONS  FKCN  FKCARG) 

FKCRESLIST) ) 

(SETQ  FKCARG  (CADR  FKCARG))) 

NIL)  ) 

(SETQ  FKCARG  (EVAL  FKCARG)) 

(COND 

((EQ  FKCARG  T) 

(SETQ  FKCARG  -1) 

(SETQ  FKCTYPE  3)) 

((NULL  FKCARG) 

(SETQ  FKCARG  0) 

(SETQ  FKCTYPE  3)) 

((LITATOM  FKCARG) 

(SETQ  FKCTYPE  (FKCATYPE  FKCARG)) 
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(SETQ  FKCARG  (FKSYM  FKCARG  FKHT) ) ) 

( (FIXP  FKCARG) 

(SETQ  FKCTYPE  0)) 

( (FLOATP  FKCARG) 

(SETQ  FKCTYPE  2)) 

( (STRINGP  FKCARG) 

(SETQ  FKCWRDS  (FKSR  FKCA  FKCN  FKCARG)) 

(OR  FKCWRDS  ( FKCALLERR  FKCID) ) 

(GO  MWARG) ) 

( (ARRAYP  FKCARG) 

(SETQ  FKCWRDS  (ARRAYSIZE  FKCARG)) 

(AND  ( IGREATERP  FKCWRDS  (IDIFFERENCE  17  FKCN)) 
(FKCALLERR  FKCID)) 

(RPTQ  FKCWRDS  (SETA  FKCA  (IPLUS  FKCN  RPTN  -1) 

(ELT  FKCARG  RPTN))) 

(GO  MWARG) ) 

( (LISTP  FKCARG) 

(ERROR  FKCARG 

"LISTS  CANNOT  BE  USED  AS  ARGUMENTS  FOR  FORK  CALLS")) 
[ ( FKARRAYP  FKCARG) 

(SETQ  FKCTYPE  (COND 

((EQ  ( FKARRAYTYPE  FKCARG) 

(QUOTE  REAL) ) 

4) 

(T  1))) 

(SETQ  FKCARG  (IPLUS  (LOC  FKCARG) 

(CADR  (FKSHR  FORKDATA) 

(T  (ERROR  FKCARG  "  ILLEGAL  ARG  TYPE  FOR  FORK  CALL"))) 

PUTARG 

(AND  (IGREATERP  FKCN  16) 

(FKCALLERR  FKCID)) 

(FKIDPB  FKCARG  FKCABP 

(SETQ  FKCN  (ADD1  FKCN)) 

(FKIDPB  FKCTYPE  FKCBP 
ENDARG 

(SETQ  FKCARG S  (CDR  FKCARGS) ) 

(GO  ARGLOOP) 

MWARG 

(SETQ  FKCN  (IPLUS  FKCN  FKCWRDS)) 

(PUTTYP  0) 

(SETQ  FKCABP  (IPLUS  FKCABP  FKCWRDS)) 

(RPTQ  (SUB1  FKCWRDS) 

(PUTTYP  5) ) 

(GO  ENDARG) 

ARGDONE 

(PUTTYP  6)  (*  END  OF  ARGS) 

(FKSACS  FKHNDL  FKCA) 

(FKSW  FKHNDL  5  T) 

(AND  DSPNOWAITFLG  (RETURN)) 

(AND  (LISTP  FKRESULTYPE) 

(SETQ  FKRESULTYPE  (EVAL  FKRESULTYPE))) 

(AND  (EQ  FKRESULTYPE  (QUOTE  SUBR) ) 

(NULL  FKCRESLIST) 

(PROGN  (FKACSRETURN  FKCA) 

(RETURN  NIL))) 

( FKRACS  FKHNDL  FKCA) 


(*  STORE  VALUE  OF  FKCARG 
INTO  FKCA)) 

(*  PUT  TYPE)) 


- 
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[MAPC  FKCRESLIST  (FUNCTION  (LAMBDA  (X) 

(SET  (CADDR  X) 

(FKRTN  (CADR  X) 

FKCA 
(CAR  X] 

(SETQ  FKRESULT  (FKRTN  FKRESULTYPE  FKCA  1)) 

(FKACSRETURN  FKCA) 

(RETURN  FKRESULT]) 

[49] 

( FKCATYPE 

[LAMBDA  (FKID) 

(PROG  ((C  (CHCON1  FKID))) 

(*  IF  FIRST  CHARACTER  OF  PNAME  OF  FKID  IS  IN  I  TO  N, 

THEN  TYPE  IS  POINTER  TO  INTEGER,  ELSE  POINTER  TO 
REAL) 


(RETURN  (COND 

([OR  (ILESSP  C  (CHCON1  (QUOTE  I))) 

( IGREATERP  C  (CHCON1  (QUOTE  N] 

4) 

(T  1]) 

[501 

( FKSR 

[LAMBDA  (A  I  STR) 

(PROG  [WDS  (DESTPTR  (LOGOR  700000000Q  (IPLUS  (LOC  A) 

I))) 

(SIZE  (NCHARS  STR)) 

(ROOM  ( IDIFFERENCE  ( ARRAYS IZE  A) 

( SUB1  I] 

(*  A  IS  ARRAY  POINTER.  I  IS  INDEX  WHERE  START 
PUTTING  STRING,  STR.  IF  STR  IS  TOO  LARGE  THEN  RETURN 
NIL,  ELSE  RETURN  NUMBER  OF  WORDS  USED. 

PUTS  ZERO  WORD  AFTER  THE  STRING) 


(SETQ  WDS  (ADD1  ( IQUOTIENT  (IPLUS  SIZE  4) 

5))) 

(AND  (IGREATERP  WDS  ROOM) 

(RETURN))  (*  DOESN'T  FIT) 

(RPTQ  WDS  (SETA  A  (IPLUS  I  RPTN  -1) 

0)  ) 

(FKJSYS  53Q  DESTPTR  STR  (IMINUS  SIZE)) 

(*  SOUT) 

(RETURN  WDS]) 

151] 

(SAILCALL 

[NLAMBDA  FKCX 

(PROG  (FKCBP  FKCABP  FKHNDL  FKHT  FKCA  FKCRESLIST  FKRESULT 
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FKRESULTB ITS  FKCARG  FKTYPE  (FKCID  (CAR  FKCX) ) 
(FKRESULTYPE  (CADR  FKCX)) 

( FKCARG S  (CDDR  FKCX)) 

( FKCN  4)) 

[SETQ  FKHNDL  ( FKHNDL  (OR  FORKDATA  (NOFORK] 

(SETQ  FKHT  (FKHT  FORKDATA)) 

(SETQ  FKCA  (FKACS) ) 

(SETQ  FKCBP  (LOGOR  -337400000000Q  (IPLUS  (LOC  FKCA) 

3)  )  ) 

(*  4  BIT  BYTE  POINTER  TO 
FKTYPE  BITS) 

(SETQ  FKCABP  (LOGOR  -333400000000Q  (IPLUS  (LOC  FKCA) 

5))) 

(*  FULL  WORD  BYTE 
POINTER  TO  ARGUMENT 
LIST) 

(COND 

[ (FMEMB  FKRESULTYPE  (QUOTE  (SUBR  REAL  INTEGER  BOOLEAN 

LOGICAL] 

((EQ  FKRESULTYPE  (QUOTE  STRING)) 

(ERROR  FKRESULTYPE 

"STRING  PROCEDURES  NOT  IMPLEMENTED  YET")) 

(T  (ERROR  FKRESULTYPE  "ILLEGAL  TYPE  FOR  SAIL  CALL"))) 

(SETQ  FKRESULTB ITS  (COND 

( FKTTYSETCALLED  -1000000000Q) 

(T  0))) 

(SETA  FKCA  1  (LOGOR  FKRESULTB ITS  (FKSYM  FKCID  FKHT))) 

ARGLOOP 

(OR  FKCARG S  (GO  ARGDONE) ) 

(SETQ  FKCARG  (SAILARG  (CAR  FKCARG S) 

FKHT)  ) 

(SETQ  FKTYPE  (CAR  FKCARG)) 

(AND  (CADDR  FKCARG) 

(SETQ  FKCRESLIST  (CONS  (CONS  FKCN  (CADDR  FKCARG)) 

FKCRESLIST) ) ) 

(SETQ  FKCARG  (CADR  FKCARG)) 

(COND 

((ATOM  FKCARG) 

(AND  ( IGREATERP  FKCN  20Q) 

(FKCALLERR  FKCID)) 

(FKIDPB  FKCARG  FKCABP) 

(SETQ  FKCN  (ADD1  FKCN)) 

(FKIDPB  FKTYPE  FKCBP)) 

(T  (AND  (IGREATERP  (SETQ  FKCN  (IPLUS  FKCN  (LENGTH  FKCARG))) 

21Q) 

(FKCALLERR  FKCID)) 

(MAPC  FKCARG  (FUNCTION  (LAMBDA  (WORD) 

(FKIDPB  WORD  FKCABP) 

(FKIDPB  FKTYPE  FKCBP) 

(SETQ  FKTYPE  14Q] 

(SETQ  FKCARG S  (CDR  FKCARG S) ) 

(GO  ARGLOOP) 

ARGDONE 

(PUTTYP  15Q)  (*  END  OF  ARGS) 

(FKSACS  FKHNDL  FKCA) 

(FKSW  FKHNDL  7)  (*  CALL  THE  FUNCTION) 

(AND  (EQ  FKRESULTYPE  (QUOTE  SUBR)) 
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(NULL  FKCRESLIST) 

(PROGN  ( FKACSRETURN  FKCA) 

(RETURN  NIL))) 

(FKRACS  FKHNDL  FKCA) 

[MAPC  FKCRESLIST  (FUNCTION  (LAMBDA  (X) 

(SET  (CADDR  X) 

(FKRTN  (CADR  X) 

FKCA 
(CAR  X) 

(SETQ  FKRESULT  (FKRTN  FKRESULTYPE  FKCA  1)) 

(FKACSRETURN  FKCA) 

(RETURN  FKRESULT]) 

(521 

(SAILARG 

[LAMBDA  (FKARG  FKHT) 

(*  FKTYPE  BITS  —  1  :  STRING,  2  :  REFERENCE 
(TO  PROCEDURE) ,  4  s  REFERENCE 
(TO  LOWER  FORK) ,  10Q  j  FKARRY) 


(PROG  ( ( FKRV  (QUOTE  VALUE)) 

(FKTYPE  0) 

FKARRY  VARTYPE  FKVALUE  FKRESULTS  FKVARBL  FKCALLTYPE) 

[COND 

[[AND  (LISTP  FKARG) 

(ATOM  (CAR  FKARG)) 

( FMEMB  (CAR  FKARG) 

(QUOTE  (REFERENCE  VALUE  INTEGER  REAL  BOOLEAN 

LOGICAL  STRING  ARRAY] 

(SETQ  FKVARBL  (CAR  (LAST  FKARG] 

(T  (SETQ  FKVARBL  FKARG) 

(SETQ  FKARG  (LIST  FKARG] 

(SETQ  FKVALUE  (EVAL  FKVARBL))  (*  INSPECT  THE  ARGUMENT) 

(COND 

((EQ  FKVALUE  T) 

(SETQ  FKVALUE  -1) 

(SETQQ  VARTYPE  INTEGER)) 

((EQ  FKVALUE  NIL) 

(SETQ  FKVALUE  0) 

(SETQQ  VARTYPE  INTEGER)) 

((LITATOM  FKVALUE) 

(SETQ  FKVALUE  (FKSYM  FKVALUE  FKHT)) 

(SETQ  FKTYPE  4)) 

( (STRINGP  FKVALUE) 

(SETQ  FKVALUE  (SAILSTRING  FKVALUE)) 

(SETQQ  VARTYPE  STRING)) 

( (FKARRAYP  FKVALUE) 

[SETQ  FKVALUE  (I PLUS  (LOC  FKVALUE) 

(CADR  (FKSHR  FORKDATA] 

(SETQ  FKTYPE  12Q) ) 

( (FIXP  FKVALUE) 

(SETQQ  VARTYPE  INTEGER)) 

( ( FLOATP  FKVALUE) 

(SETQQ  VARTYPE  REAL)) 
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( (LISTP  FKVALUE) 

(ERROR  FKVALUE 

"LISTS  CANNOT  BE  USED  AS  ARGUMENTS  FOR  FORK  CALLS")) 
(T  (ERROR  FKVALUE  "ILLEGAL  ARG  TYPE  FOR  SAIL  CALL"))) 

(*  INSPECT  THE 
MODIFIERS) 

(SETQ  FKCALLTYPE  (OR  VARTYPE  (QUOTE  INTEGER))) 

IMAP  FKARG  (FUNCTION  (LAMBDA  (X) 

(AND  (CDR  X) 

( SELECTQ  (CAR  X) 

(REFERENCE  (SETQQ  FKRV  REFERENCE)) 
(VALUE  (SETQQ  FKRV  VALUE)) 

(INTEGER  (SETQQ  FKCALLTYPE  INTEGER)) 
(REAL  (SETQQ  FKCALLTYPE  REAL)) 
((BOOLEAN  LOGICAL) 

(SETQQ  FKCALLTYPE  LOGICAL)) 

(STRING  (SETQQ  FKCALLTYPE  STRING)) 
(ARRAY  (SETQ  FKARRY  T) ) 

(ERROR  (CAR  X) 

"ILLEGAL  ARGUMENT  TYPE  FOR  SAIL  CALL"] 

(*  PERFORM  FKTYPE 
CONVERSIONS) 

[AND  VARTYPE  (NEQ  FKCALLTYPE  VARTYPE) 

(PROGN  (COND 

((EQ  VARTYPE  (QUOTE  STRING)) 

(SETQ  FKVALUE  (LLSH  (CAR  FKVALUE) 

-35Q) ) 

(SETQQ  VARTYPE  INTEGER))) 

(COND 

((AND  (EQ  VARTYPE  (QUOTE  REAL)) 

(EQ  FKCALLTYPE  (QUOTE  INTEGER))) 

(SETQ  FKVALUE  (FIX  FKVALUE))) 

((AND  (EQ  VARTYPE  (QUOTE  INTEGER)) 

(EQ  FKCALLTYPE  (QUOTE  REAL))) 

(SETQ  FKVALUE  (FLOAT  FKVALUE))) 

((EQ  FKCALLTYPE  (QUOTE  STRING)) 

(AND  (EQ  VARTYPE  (QUOTE  REAL)) 

(SETQ  FKVALUE  (FIX  FKVALUE))) 

(SETQ  FKVALUE  (LLSH  FKVALUE  35Q] 

(*  SET  FKTYPE  BITS) 

(AND  (EQ  FKCALLTYPE  (QUOTE  STRING)) 

(SETQ  FKTYPE  (LOGOR  FKTYPE  1))) 

(AND  (EQ  FKRV  (QUOTE  REFERENCE)) 

(SETQ  FKTYPE  (LOGOR  FKTYPE  2)) 

(LITATOM  FKVARBL) 

(SETQ  FKRESULTS  (LIST  FKCALLTYPE  FKVARBL))) 

(AND  FKARRY  (SETQ  FKTYPE  (LOGOR  12Q  FKTYPE))) 

(RETURN  (LIST  FKTYPE  FKVALUE  FKRESULTS]) 


[531 


(SAILSTRING 

(LAMBDA  (STRING) 


(PROG  (VAL  ZEROS  CHLIST  PACKEDLIST) 


(*  THIS  COULD  PROBABLY 
BE  DONE  MUCH  MORE 
QUICKLY) 
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(SETQ  CHLIST  (CHCON  STRING)) 

STRING LOOP 

[OR  CHLIST  (PROGN  (OR  ZEROS  (SETQ  PACKEDLIST 

(CONS  0  PACKEDLIST))) 
(RETURN  (REVERSE  PACKEDLIST] 

(SETQ  VAL  0) 

[RPTQ  5  (PROGN  (SETQ  VAL  (IPLUS  (LLSH  VAL  7) 

(OR  (CAR  CHLIST) 
0))) 

(OR  (CAR  CHLIST) 

(SETQ  ZEROS  T) ) 

(SETQ  CHLIST  (CDR  CHLIST] 

(SETQ  PACKEDLIST  (CONS  (LLSH  VAL  1) 

PACKEDLIST) ) 

(GO  STRINGLOOP]) 


[54] 


(FKACS 

[LAMBDA  NIL 

(PROG  ( (Y  (CDDR  FORK DATA ) ) 

X) 

(RETURN  (COND 

((SETQ  X  (CAR  Y)) 
(RPLACA  Y  (CDR  X) ) 

(CRT}  Yi  ) 

(T  (ARRAY  20Q  20Q] ) 


[551 


( FKACSRETURN 

[LAMBDA  (ARRAY) 

(PROG  ((Y  (CDDR  FORKDATA) ) ) 

(RETURN  (RPLACA  Y  (CONS  ARRAY  (CAR  Y] ) 


[56] 


( FKRTN 

[LAMBDA  (TYPE  A  N) 

(SELECTQ  TYPE 

(INTEGER  (ELT  A  N)  ) 

(REAL  (ASSEMBLE  NIL 

<CQ  (VAG  (IPLUS  (LOC  A) 

N)  ) ) 

(MOVE  1  r  1  (D) 

(FASTCALL  MKFN) ) ) 

[LOGICAL  (NOT  (ZEROP  (ELT  A  N] 

(SUBR  NIL) 

(ERROR  TYPE  "ILLEGAL  RESULT  TYPE  FOR  FORK  CALL"]) 


[571 


(NOFORK 

(LAMBDA  NIL 

(PRIN1  "NO  FORK! 

PROGRAM  NAME:  ") 

(APPLY*  (FUNCTION  FKINIT) 


i 
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(READ) ) 
FORKDATAl ) 


(FKCALLERR 

(LAMBDA  (FKCID) 

(ERROR  FKCID  "  TOO  MANY  WORDS  OF  ARGS  FOR  A  FORK  CALL"]) 


(FKSW 

[LAMBDA  ( FKHNDL  I  FKNOWAITFLG) 


(*  NOBIND 

"24-NOV-78  12:43") 


(PROG  ((EXPECTED  (FKHALT  FORKDATA) )  I 

HALTED)  I 

(COND  I 

( ( ILESSP  I  33)  I 

(FKJSYS  129  FKHNDL  I)  (*  SFRKV)  I 

)  I 

(T  (FKJSYS  111  FKHNDL  I)  (*  SFORK)  I 

))  I 

(AND  FKNOWAITFLG  DSPNOWAITFLG  (RETURN  EXPECTED))  I 

(FKJSYS  115  FKHNDL)  (*  WFORK)  I 

(FKJSYS  110  FKHNDL)  (*  RFSTS)  I 

(SETQ  HALTED  (LOGAND  FKJSYSAC2  262143))  I 

(AND  EXPECTED  (NULL  (EQP  HALTED  EXPECTED))  I 

(RESETFORM  (RADIX  8)  I 

(HELP  "LOWER  FORK  HALTED  AT  ADDRESS:  "  HALTED) 
))  I 

(RETURN  HALTED]) 


(FKX 

(NLAMBDA  (FKCX) 

(EVAL  (LIST  (QUOTE  RESETFORM) 

(QUOTE  (FKTTYSET  T)  ) 
FKCX] ) 


(FKTTYSET 

(LAMBDA  (BOOL) 


(*  IF  BOOL  IS  T,  DISARMS  LISP  CONTROL  CHARACTER 
INTERRUPTS,  EXCEPT  FOR  AB,  AD,  AE,  AND  AH. 

IF  BOOL  IS  NIL,  RESTORES  INTERRUPTS  AND  TERMINAL 
CHARACTERISTICS) 


(COND 

((EQ  BOOL  (QUOTE  INITIAL)) 

(FKJSYS  112Q  101Q)  (*  RFCOC) 

(SETQ  FKCC1  FKJSYSAC2) 

(SETQ  FKCC2  FKJSYSAC3) 

(FKJSYS  107Q  101Q)  (*  RFMOD) 
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(SETQ  FKFMOD  FKJSYSAC2) 

(FKJSYS  173Q  400000Q)  (*  RTIW) 

(SETQ  FKTIW  FKJSYSAC2) 

(FKJSYS  174Q  400000Q  131000000000Q)  (*  STIW  FOR  ~B,  “D,  ~Er 

AND  “H) 

(SETQ  FKTTYSETCALLED  T) 

NIL) 

(BOOL  (FKJSYS  174Q  400000Q  131000000000Q) 

(*  STIW) 

(SETQ  FKTTYSETCALLED  T) 

NIL) 

(T  (FKJSYS  113Q  101Q  FKCC1  FKCC2)  (*  SFCOC) 

(FKJSYS  110Q  101Q  FKFMOD)  (*  SFMOD) 

(FKJSYS  174Q  400000Q  FKTIW)  (*  STIW) 

(SETQ  FKTTYSETCALLED  NIL) 

Tl) 


(62) 


( FKARRAY 

[NLAMBDA  (FKA  FKTYPE  FKSIZE  FKSIZE2) 

(PROG  ( (FKOFFSET  0) 

(FKTOTALSIZE  1) 

(FKNDIM  0) 

[FKSIZES  (COND 

( (NLISTP  FKSIZE) 

(EVAL  FKSIZE)) 

((GETD  (CAR  FKSIZE)) 

/PV»T  PlfCTJP^  1 

(T  ( MAPCAR  FKSIZE  (FUNCTION  EVAL] 
FKDIMS  FKDOPE  FKHI  FKLO  FKBYTP  FKDATAWD  FKLOC) 
(OR  FORKDATA  (NOFORK) ) 

(SETQ  FKTYPE  (SELECTQ  FKTYPE 

(REAL  -1) 

(INTEGER  0) 


(ERROR  FKA 

"  HAS  ILLEGAL  TYPE  DECLARATION"))) 

(COND 

(FKSIZE2  (SETQ  FKHI  (EVAL  FKSIZE2) ) 

(SETQ  FKOFFSET  (ADD1  FKSIZES)) 

(SETQ  FKNDIM  2) 

(SETQ  FKTOTALSIZE  (ITIMES  FKSIZES  FKHI)) 

(SETQ  FKDOPE  (LIST  1  FKSIZES  1  FKSIZES  FKHI  1)) 
(GO  FKDIMDONE) ) ) 

[SETQ  FKDIMS  (COND 
( (LISTP  FKSIZES) 

(REVERSE  FKSIZES)) 

(T  (LIST  FKSIZES  1] 

FKDIMLOOP 

(OR  (AND  (NUMBERP  (SETQ  FKHI  (CAR  FKDIMS))) 

(NUMBERP  (SETQ  FKLO  (CADR  FKDIMS))) 

(NOT  (ILESSP  FKHI  FKLO))) 

(ERROR  FKSIZES  "INVALID  INDEX  SPECIFICATION")) 

(SETQ  FKDOPE  (CONS  FKTOTALSIZE  (CONS  FKHI  (CONS  FKLO  FKDOPE] 
(SETQ  FKOFFSET  (IPLUS  FKOFFSET  (ITIMES  FKTOTALSIZE  FKLO))) 
(SETQ  FKNDIM  (ADD1  FKNDIM)) 

[SETQ  FKTOTALSIZE  (ITIMES  FKTOTALSIZE 


«*?*•' 


a 


► 
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(ADD1  (IDIFPERENCE  FKHI  FKLOJ 
(AND  (SETQ  FKDIMS  (CDDR  FKDIMS) ) 

(GO  FKDIMLOOP) > 

FKDIMDONE 

(SETQ  FKLOC  (FKCORGET  (IPLUS  FKTOTALSIZE  (ITIMES  FKNDIM  3) 

4))) 

(SETQ  FKBYTP  (LOGOR  -333400000000Q  FKLOC)) 

(FKIDPB  (SETQ  FKDATAWD  (IPLUS  FKLOC  (ITIMES  FKNDIM  3) 

4)) 

FKBYTP) 


(FKIDPB  FKTYPE  FKBYTP) 


(*  POINTS  TO  FIRST  DATA 
WORD) 

(*  TYPE  —  POINTS  TO 
LITERAL  ATOM  —  SHOULDNT 
MOVE  DURING  GARBAGE 
COLLECTION) 


[ FKSYMPUT  (FKHT  FORKDATA) 

FKA 

(IPLUS  FKDATAWD  (CADR  (FKSHR  FORKDATA] 
(FKIDPB  (IPLUS  FKDATAWD  (CADR  (FKSHR  FORKDATA)) 

( IMINUS  FKOFFSET) ) 

FKBYTP) 


IMAPC  (REVERSE  FKDOPE) 

(FUNCTION  (LAMBDA  (WORD) 
(FKIDPB  WORD  FKBYTP] 


(FKIDPB  (LOGOR  (LLSH  FKNDIM  22Q) 
FKTOTALSIZE) 

FKBYTP) 

(RETURN  (SET  FKA  (VAG  FKDATAWD]) 


(*  BASE  ADDRESS  FOR  SAIL 
ADDRESS  CALCULATION) 


(*  FOR  EACH  DIMENSION, 
LOWERBOUND,  UPPER  BOUND, 
MULTIPLIER) 


(*  XWD  NDI MS,, TOTAL 
FKTOTALSIZE) 


1631 


(FKCORGET 

[LAMBDA  (SIZE) 

(PROG  ((SHR  (FKSHR  FORKDATA)) 

X) 

(AND  ( IGREATERP  SIZE  (CAR  SHR)) 

(ERROR  (FKPROG  FORKDATA) 

"  SHARED  PAGES  EXCEEDED")) 
(SETQ  X  ( IDIFFERENCE  (CADDR  SHR) 

(CAR  SHR))) 

(RPLACA  SHR  (IDIFFERENCE  (CAR  SHR) 

SIZE)  ) 

(RETURN  X]) 


[641 


(FKELT 

[NLAMBDA  (FKELT1A  FKELT IN  FKELT1WORDS) 

(APPLY*  (SELECTQ  (FKARRAYTYPE  (EVAL  FKELT1A) ) 

(REAL  (FUNCTION  FKELTR) ) 
(INTEGER  (FUNCTION  FKELTI) ) 
(QUOTE  ARRAYSCLOBBERED1 ) ) 
FKELTI A  FKELT IN  FKELT I WORDS ] ) 


4 &&&**»> " 
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[651 


( FKELTI 

INLAMBDA  (FKELTI1A  FKELTI IN  FKELTI IWORDS) 

(PROG  (PTR  ANS) 

(SETQ  FKELTI (WORDS  (EVAL  FKELTI IWORDS) ) 

(SETQ  PTR  ( FKARRADR  FKELTI 1 A  FKELTI IN  FKELTI IWORDS) ) 

(RETURN  (COND 

[FKELTI IWORDS  (RPTQ  FKELTI IWORDS 

(SETQ  ANS 

(CONS  (OPENR  (I PLUS  PTR  RPTN 

-D) 

ANSI 


(T  (OPENR  PTR]) 


[661 


(FKELTR 

[NLAMBDA  (FKELTR! A  FKELTR IN  FKELTR IWORDS) 

(PROG  (PTR  ANS) 

(SETQ  FKELTR IWORDS  (EVAL  FKELTR IWORDS) ) 

(SETQ  PTR  (FKARRADR  FKELTR! A  FKELTR 1 N  FKELTR IWORDS ) ) 

(RETURN  (COND 

[FKELTR IWORDS  (RPTQ  FKELTR IWORDS 

(SETQ  ANS 

(CONS  ( FKFLOAT  (I PLUS  PTR 

RPTN  -D) 


ANS) 


(T  (FKFLOAT  PTR]) 


[671 


(FKSETA 

[NLAMBDA  ( FKARRY  FK INDEX  FKEXPR) 

(PROG  ( FKPTR  FKVAL) 

(SETQ  FKVAL  (EVAL  FKEXPR)) 

[SETQ  FKPTR  (FKARRADR  FKARRY  FKINDEX  (AND  (LISTP  FKVAL) 

(LENGTH  FKVAL] 


(RETURN  (COND 

[(LISTP  FKVAL) 

( MAPCAR  FKVAL  (FUNCTION  (LAMBDA  (FKV) 

(PROG1  (CLOSER  FKPTR  FKV) 

(SETQ  FKPTR  (ADDI  FKPTR] 

((CLOSER  FKPTR  FKVAL) 

FKVAL] ) 


[68] 


(FKARRAYP 
[LAMBDA  (A) 

(PROG  KSHR  (CDDR  (FKSHR  FORKDATA] 

(RETURN  (AND  SHR  ( IGREATERP  (CAR  SHR) 

(LOC  A)) 

(NOT  (IGREATERP  (CADR  SHR) 
(LOC  A))) 


A]) 
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169] 


(FKARRAYSIZE 
[LAMBDA  (A) 

(LOGAND  777777Q  (OPENR  (SUB1  (LOC  Al ) 


[70] 


(SAILARRAYSIZE 
[LAMBDA  (A) 

(PROG  ((X  (LOC  A)) 

ANS  NDIM) 

( SETQ  NDIM  (LRSH  (OPENR  (SUB1  X)) 

22Q)  ) 

[RPTQ  NDIM  (PROGN  (SETQ  X  (IDIFFERENCE  X  3)) 

(SETQ  ANS 

(CONS  (OPENR  X) 

(CONS  (OPENR  (SUB1  X) ) 
ANS] 

(RETURN  (REVERSE  ANSI ) 


[71] 


( FKARRAYTYPE 
[LAMBDA  (A) 

(PROG  (NDIM) 

(SETQ  NDIM  (LRSH  (OPENR  (SUB1  (LOC  A))) 

22Q) ) 

(RETURN  (COND 

([ZEROP  (OPENR  (IDIFFERENCE  (LOC  A) 

( I PLUS  ( ITIMES  NDIM  3) 
3] 


(QUOTE  INTEGER)) 
(T  (QUOTE  REAL!) 


1721 


(FKBCHECK 

[LAMBDA  (N  LO  HI) 

(AND  (OR  ( IGREATERP  N  HI) 

(ILESSP  N  LO)) 

(ERROR  N  "  INDEX  OUT  OF  RANGE"]) 


(731 


( FKARRADR 

[LAMBDA  (FKARRNAME  FK INDEX  FKNWORDS) 

(PROG  ( (FKARRY  (EVAL  FKARRNAME)) 

FKADR  FKNDIM  FKSIZE  FKLOW  (FKOFFSET  0) 

FKDIMS  FKPTR) 

(OR  (FKARRAYP  FKARRY) 

(ERROR  FKARRY  *  —  ARG  NOT  SHARED  ARRAY")) 
(SETQ  FKADR  (LOC  FKARRY)) 

[SETQ  FKDIMS  (COND 
( (NLISTP  FKINDEX) 

(EVAL  FKINDEX)) 
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((GETD  (CAR  FKINDEX) ) 

(EVAL  FKINDEX)) 

(T  (MAPCAR  FKINDEX  (FUNCTION  EVAL) 

ICOND 

((NUMBERP  FKDIMS) 

[SETQ  FKSIZE  (LOGAND  777777Q  (OPENR  (SUB1  FKADR) 

(FKBCHECK  FKDIMS  1  FKSIZE) 

(SETQ  FKOFFSET  (SUB1  FKDIMS))) 

(T  (SETQ  FKNDIM  (LRSH  (OPENR  (SUB1  FKADR)) 

22Q) ) 

(OR  (EQP  FKNDIM  (LENGTH  FKDIMS)) 

(ERROR  FKINDEX 

"  WRONG  NUMBER  OF  DIMENSIONS  FOR  ARRAY")) 

(SETQ  FKPTR  FKADR) 

[MAPC  FKDIMS  (FUNCTION  (LAMBDA  (X) 

(SETQ  FKPTR  ( IDIFFERENCE  FKPTR  3)) 

(SETQ  FKLOW  (OPENR  (SUB1  FKPTR))) 

(FKBCHECK  X  FKLOW  (OPENR  FKPTR)) 

(SETQ  FKOFFSET 

(IPLUS  FKOFFSET  (ITIMES  (OPENR  (ADD1  FKPTR)) 

(IDIFFERENCE  X  FKLOW) 

(AND  FKNWORDS  (SETQ  FKSIZE  (LOGAND  777777Q 

(OPENR  ( SUBl  FKADR] 

(AND  FKNWORDS  (FKBCHECK  (IPLUS  FKOFFSET  FKNWORDS) 

1  FKSIZE)) 

(RETURN  (IPLUS  FKADR  FKOFFSET)) 


[74) 


( FKFLOAT 

[LAMBDA  (ADR) 

(ASSEMBLE  NIL 

(CQ  (VAG  ADR)) 
(MOVE  1  ,  0  <D) 
(FASTCALL  MKFN) ) 


(75) 


(ARRLOC 

[LAMBDA  (ARR) 

(COND 

( ( ARRAY P  ARR) 

(IPLUS  2  (LOC  ARR))) 

( ( FKARRAYP  ARR) 

(LOC  ARR)) 

((ERROR  ARR  "ARG  NOT  ARRAY"]) 


[76] 


(FKVAL 

( NLAMBDA  (FKADR  FKBIAS  FKWORDS) 
(APPLY*  (FUNCTION  FKVAL I) 

FKADR  FKBIAS  FKWORDS  (COND 
((EQ  (FKCATYPE  FKADR) 

4) 

(QUOTE  REAL]) 
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(FKVALR 

[NLAMBDA  (FKADR  F KB IAS  FKWORDS) 

(APPLY*  (FUNCTION  FKVALI) 

FKADR  FKBIAS  FKWORDS  (QUOTE  REAL!) 


178] 


(FKVALI 

(NLAMBDA  (FKADR  FKBIAS  FKWORDS  FKREAL)  (*  NOBIND 

"24-Nov-78  12:58") 

(PROG  ( FKHNDL  FKHT  FKACS  FKBP  FKRESULT) 

(OR  FORKDATA  (NOFORK)) 

(SETQ  FKHNDL  (FKHNDL  FORKDATA)) 

( FKWAIT  FKHNDL)  I 

(SETQ  FKHT  (FKHT  FORKDATA)) 

(SETQ  FKACS  (FKACS)) 

(SETQ  FKBP  (LOGOR  -29460791296  (IPLUS  (LOC  FKACS)  I 

2)))  I 

(*  FULL  WORD  POINTER  TO 
FIRST  WORD  OF  FKACS)  I 
(FKIDPB  15032385536  FKBP)  (*  ONE  ARGUMENT,  POINTER 

TYPE) 


(FKIDPB  (FKSYM  (QUOTE  FKVAL) 
FKHT) 


FKBP) 

(FKIDPB  (IPLUS  -1  (OR  (EVAL  FKBIAS) 

1) 

(FKSYM  FKADR  FKHT)) 

FKBP)  (*  ADDRESS  OF  COMMON  OR 

VARIABLE) 


( FKSACS  FKHNDL  FKACS) 

(FKSW  FKHNDL  5) 

( FKRACS  FKHNDL  FKACS) 

(SETQ  FKBP  (IPLUS  (LOC  FKACS) 

4)) 


[COND 

[FKWORDS  (SETQ  FKWORDS  (EVAL  FKWORDS)) 

(COND 

( ( IGREATERP  FKWORDS  14) 

(HELP  FKWORDS 

"  —  TOO  MANY  WORDS  FOR  FKVAL 

TYPE  % "RETURN) %"  TO  GET  FIRST  14  WORDS") 

(SETQ  FKWORDS  14))) 

(RPTQ  FKWORDS 

(SETQ  FKRESULT 
(CONS  [COND 

(FKREAL  ( FKFLOAT  (IPLUS  FKBP  RPTN 

-1))) 

( (OPENR  (IPLUS  FKBP  RPTN  -1] 
FKRESULT] 

(FKREAL  (SETQ  FKRESULT  (FKFLOAT  FKBP))) 

((SETQ  FKRESULT  (OPENR  FKBP] 

(FKACSRETURN  FKACS) 

(RETURN  FKRESULT]) 
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(FKSETVAL 

INLAMBDA  (FKADR  FKBIAS  FKVAL) 


(*  NOBIND 

"24-NOV-78  13:00") 


(PROG  (FKHNDL  FKHT  FKACS  FKBP  FKRESULT) 

(OR  FORKDATA  (NOFORK)) 

(SETQ  FKHNDL  (FKHNDL  FORKDATA)) 

(FKWAIT  FKHNDL) 

(SETQ  FKHT  (FKHT  FORKDATA)) 

(SETQ  FKACS  (FKACS)) 

(SETQ  FKBP  (LOGOR  -29460791296  (IPLUS  (LOC  FKACS) 


(FKIDPB  8685804397  FKBP)  (*  ARGUMENT 

(FKIDPB  (LOGOR  -19595788288  (FKSYM  (QUOTE  FKSETV) 

FKHT) ) 

FKBP) 

(FKIDPB  (IPLUS  -1  (EVAL  FKBIAS) 

(FKSYM  FKADR  FKHT)) 


2)))  I 
(*  FULL  WORD  POINTER  TO 
FIRST  WORD  OF  FKACS)  I 
(*  ARGUMENT  BITS) 


FKBP) 

(SETQ  FKVAL  (EVAL  FKVAL)) 

(OR  (LISTP  FKVAL) 

(SETQ  FKVAL  (LIST  FKVAL))) 
(COND 

( ( IGREATERP  (LENGTH  FKVAL) 
12) 

(HELP  (LENGTH  FKVAL) 


(*  ADDRESS  OF  COMMON  OR 
VARIABLE) 


"  —  TOO  MANY  WORDS  FOR  FKSETVAL 
TYPE  % "RETURN) % "  TO  SET  FIRST  12  WORDS") 

(SETQ  FKVAL  (COPY  FKVAL)) 

( RPLACD  (NTH  FKVAL  12) 

NIL) ) ) 

(FKIDPB  (LENGTH  FKVAL) 

FKBP) 

[MAPC  FKVAL  (FUNCTION  (LAMBDA  (VAL) 

(FKIDPB  (COND 

((NUMBERP  VAL) 

VAL) 

((NULL  VAL) 

0) 

( ( EQ  VAL  T) 

-1) 

(T  (ERROR  VAL 

"  —  NON-NUMERIC  ARG  IN  FKSETVAL"))) 

FKBP] 

(FKSACS  FKHNDL  FKACS) 

(FKSW  FKHNDL  5) 

(FKACSRETURN  FKACS) 

(RETURN  FKVAL] ) 
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(FKSYM 

[LAMBDA  (ID  FKHT  NOBREAK) 

<*  LOOKS  FOR  ID  IN  FORK  HASH  TABLE. 

IF  CANNOT  FIND,  THEN  GOES  TO  FORK  DDT  TO  LOOK  IT 
UP.) 
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[OR  FKHT  (SETQ  FKHT  (FKHT  (OR  FORKDATA  (NOFORK] 

(OR  (FIXP  ID) 

(GETHASH  ID  FKHT) 

(PROG  (P  FKHNDL)  (*  GETS  DEFINITION  OF  ID 

FROM  DDT  FOR  THE 
FORKNAME) 


(SETQ  P  (FKSYMACS  FORKDATA)) 

(SETQ  FKHNDL  (FKHNDL  FORKDATA)) 

(SETA  P  1  (GETRADIX50  ID)) 

(FKSACS  FKHNDL  P) 

(FKSW  FKHNDL  4) 

(FKRACS  FKHNDL  P) 

[AND  (ZEROP  (ELT  P  1)) 

(COND 

(NOBREAK  (RETURN  NIL)) 

(T  (ERROR  ID  "  NOT  DEFINED  IN  FORK"] 

(RETURN  (FKSYMPUT  FKHT  ID  (ELT  P  2]) 

[811 


(FKSYMPUT 

[LAMBDA  (FKHT  ID  V) 

(PROG  ( (HTL  (LIST  FKHT))) 

(PUTHASH  ID  V  HTL)  (*  EXPANDS  HT  IF 

NECESSARY) 

(FKHT_  FORKDATA  (CAR  HTL)) 

(RETURN  V]) 

[821 


(FKSYMP 

[LAMBDA  (ID) 

(FKSYM  ID  NIL  T] ) 


[831 


(GETRADIX50 
[LAMBDA  (S) 

(PROG  ( RADTMP  [LEN  (COND 

( ( ILESSP  6  (NCHARS  S)  ) 

6) 

((NCHARS  S] 

(RAD  0) 

(TS  (SUBSTRING  S  1  -1))) 

[RPTQ  LEN  (PROGN  (SETQ  RADTMP  (CHCON1  (GNC  TS) ) ) 

(COND 

((AND  (IGREATERP  RADTMP  57Q) 

(ILESSP  RADTMP  72Q) ) 

(SETQ  RADTMP  (IDIFFERENCE  RADTMP  57Q) ) ) 
((AND  (IGREATERP  RADTMP  100Q) 

(ILESSP  RADTMP  133Q) ) 

(SETQ  RADTMP  (IDIFFERENCE  RADTMP  66Q) ) ) 
((AND  (IGREATERP  RADTMP  140Q) 

(ILESSP  RADTMP  173Q) ) 

(SETQ  RADTMP  (IDIFFERENCE  RADTMP  126Q) ) ) 
((EQ  RADTMP  56Q) 

(SETQ  RADTMP  (IDIFFERENCE  RADTMP  11Q) ) ) 
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(RETURN  RAD]) 


((OR  (EQ  RADTMP  44Q) 

(EQ  RADTMP  45Q) ) 

(SETQ  RADTMP  (I PLUS  RADTMP  2))) 
(T  (RETURN  0))) 

(SETQ  RAD  ( I PLUS  (ITIMES  RAD  50Q) 

RADTMP] 


(841 


(FKTIME 

[LAMBDA 

(PROG 


(FKEXPR) 

(FKRESULT  FKLISPTIME  FKFORKTIME  FKHNDL) 

(AND  FORKDATA  (FKJSYS  15Q  (SETQ  FKHNDL  (FKHNDL  FORKDATA))) 
(SETQ  FKFORKTIME  FKJSYSAC1) ) 

(FKJSYS  15Q  400000Q) 

(SETQ  FKLISPTIME  FKJSYSAC1) 

(SETQ  FKRESULT  (EVAL  FKEXPR)) 

(FKJSYS  15Q  400000Q) 

(SETQ  FKLISPTIME  (FQUOTIENT  ( IDIFFERENCE  FKJSYSAC1  FKLISPTIME) 

FKJSYSAC2) ) 

(AND  FKFORKTIME  (FKJSYS  15Q  FKHNDL) 

(SETQ  FKFORKTIME  (FQUOTIENT  (IDIFFERENCE  FKJSYSAC1 

FKFORKTIME) 

FKJSYSAC2) ) ) 

(RETURN  (LIST  FKRESULT  (FPLUS  FKLISPTIME  FKFORKTIME) 

FKLISPTIME  FKFORKTIME]) 


[851 


( FKJ SYS 

[LAMBDA  (FKJSYSNO  ARG1  ARG2  ARG3  ARG4  ARG5) 

(ASSEMBLE  NIL 

(CQ  (VAG  FKJSYSNO)) 

(HRRM  1  ,  FKJSYS) 

(MOVE I  1  ,  4) 

( MOVEM  1  ,  RETCNT) 

(CQ  (FKJSYSARG  ARG2) ) 

(MOVEM  1  ,  AC2) 

(CQ  (FKJSYSARG  ARG3 ) ) 

(MOVEM  1  ,  AC3) 

(CQ  (FKJSYSARG  ARG4) ) 

(MOVEM  1  ,  AC 4) 

(CQ  (FKJSYSARG  ARG5) ) 

(MOVEM  1  ,  AC5) 

(CQ  (FKJSYSARG  ARG1) ) 

(MOVE  2  ,  AC2) 

(MOVE  3  ,  AC3) 

(MOVE  4  ,  AC4) 

(MOVE  5  ,  AC5) 

FKJSYS 

(JSYS  0) 

(SOS  RETCNT) 

(SOS  RETCNT) 

(SOS  RETCNT) 

(MOVEM  2  ,  AC2) 

(MOVEM  3  ,  AC3) 


(*  NOBIND 
"29-NOV-78  17:38") 


■uu 
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ICQ  (SETQ  FKJSYSAC1  (LOC  (AC1 
(MOVE  1  ,  AC2) 

(CQ  (SETQ  FKJSYSAC2  (LOC  (AC] 
(MOVE  1  ,  AC3) 

ICQ  (SETQ  FKJSYSAC3  (LOC  (AC] 
(MOVE  1  ,  RETCNT) 

(FASTCALL  MKN) 

( JRST  RETURN) 

RETCNT 

(0) 

AC2  (0) 

AC3  (0) 

AC4  (0) 

AC5  (0) 

RETURN] ) 


1861 


(FKJSYSARG 

[LAMBDA  (X)  (*  NOBIND 

"29-Nov-78  17:44") 

(PROG  (ARG  S) 

A  [SETQ  ARG  (COND 
((NULL  X) 

0) 

( ( STRINGP  X) 

[SETQ  FKJSYSTR  (COND 

((ZEROP  (CHCON1  (NTHCHAR  X  -1))) 

X) 

(T  (CONCAT  X  (CHARACTER  0] 

(SETQ  S  ( IPLUS  (LOC  (CAR  FKJSYSTR)) 

(LSH  (LOGAND  (LOC  (CDR  FKJSYSTR)) 

7) 

18)  )  ) 


(LOGOR  ( IQUOTIENT  S  5) 

117440512 

(LLSH  ( IDIFFERENCE  36  (ITIMES  (IREMAINDER  S 

7)) 


30))) 

( (ARRAYP  X) 

(IPLUS  2  (LOC  X))) 

((NUMBERP  X) 

X) 

(T  (SETQ  X  (ERROR  X  "FKJSYS  ARGUMENT  ERROR")) 
(GO  A] 

(RETURN  (VAG  ARG]) 


5) 


I 

I 


[87] 


(FKWAIT 

[LAMBDA  (FKHNDL) 

(PROG  NIL 

WAIT (FKJSYS  156Q  FKHNDL) 

(SETQ  FKSTATUS  (LRSH  FKJSYSAC1  22Q) ) 
(COND 

((EQ  FKSTATUS  2)) 


(*  NOBIND 
"24-NOV-78  16:42") 

(*  RFSTS) 


t 
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) 


(  ( EQ  FKSTATUS  1) 

(FKJSYS  206Q  FKHNDL) 
(FKJSYS  104Q  (LOGAND 

(FKJSYS  162Q  FKHNDL) 
(DISMISS  12Q) ) 

( (MEMB  FKSTATUS  (QUOTE 
(DISMISS  764Q) 

(GO  WAIT) ) 

(T  (HELP  "UNUSUAL  FORK 


(*  GPJFN) 

FKJSYSAC2  777777Q) ) 

(*  DOBE) 
(*  HFORK) 


(0  4  5))) 


STATUS:"  FKSTATUS]) 


(ADDTOVAR  GLOBALVARS  FORKDATA  DSPNOWAITFLG) 


(ADDTOVAR  AFTERSYSOUTFORMS  (PROGN  ( RPLACA  FORKDATA  NIL) 

(FKKILL) ) ) 

(AND  (EQ  (EVALV  (QUOTE  FORKDATA)) 

(QUOTE  NOBIND) ) 

(SETQ  FORKDATA  NIL)) 


(PUTPROPS  FKIDPB  MACRO  £ ( E  P) 

(ASSEMBLE  NIL 

(CQ  (VAG  E)  ) 
(PUSHN  1) 

(CQ  P) 

,  •  (POPN  2) 

(IDPB  2  ,  0  (in 


(PUTPROPS  FKRACS  MACRO  ((FKHNDL  A) 

(ASSEMBLE  NIL 

(CQ  (VAG  ( IPLUS  (LOC  A) 
2))) 

(PUSHN  1) 

(CQ  (VAG  FKHNDL) ) 

(POPN  2) 

( JSYS  161Q) ) 

(*  RFACS) 


)) 


(PUTPROPS  FKSACS  MACRO  ((FKHNDL  A) 

(ASSEMBLE  NIL 

(CQ  (VAG  (IPLUS  (LOC  A) 

2))) 


)) 


(PUSHN  1) 

(CQ  (VAG  FKHNDL)) 

(POPN  2) 

(JSYS  160Q) ) 

(*  SFACS) 


(PUTPROPS  PUTTYP  MACRO  [(N) 

(ASSEMBLE 


NIL 

(CQ  FKCBP) 

(HRRZI  2  f  N) 
(IDPB  2  ,  0  (U) 


(PUTPROPS  FKHNDL  MACRO  ((X) 
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(CAR  X))) 

(PUTPROPS  FKHT  MACRO  ((X) 

(CAADR  X))) 

(PUTPROPS  FKSHR  MACRO  ((X) 

(CADDDR  X) ) ) 

(PUTPROPS  FKSYMACS  MACRO  ((X) 

(CADR  (CDDDR  X) ) ) ) 


(PUTPROPS  FKDDT  MACRO  ((X) 

(CADR  (CDDDDR  X)))) 

(PUTPROPS  FKJFN  MACRO  ((X) 

( CADDR  (CDDDDR  X) ) ) ) 

(PUTPROPS  FKHT_  MACRO  ((X  Y) 

(RPLACA  (CADR  X) 

Y)  )) 


(PUTPROPS  FKDDT_  MACRO  ((X  Y) 

(RPLACA  (CDDR  (CDDDR  X)) 

Y>>) 

(PUTPROPS  FKPROG  MACRO  ((X) 

(CADDDR  (CDDDDR  X)))) 

(PUTPROPS  FKHALT  MACRO  ((X) 

(CADADR  X))) 

( RPAQQ  FORKBLOCKS  ( ( FKCALLBLOCK  FKCALL  FKCATYPE  FKSR  SAILCALL  SAILARG 

SAILSTRING  FKACS  FKACSRETURN  FKRTN 
( NOLINKFNS  .  T) 

(ENTRIES  FKCALL  SAILCALL  FKCATYPE  FKACS 
FKACSRETURN) ) 

( FKARRAYBLOCK  FKARRAY  FKCORGET  FKELT  FKELTI  FKELTR  FKSETA 

FKARRAYP  FKBCHECK  FKARRADR  FKFLOAT  (NOLINKFNS  .  T) 
(ENTRIES  FKARRAY  FKELT  FKELTI  FKELTR  FKSETA 
FKARRAYP  FKFLOAT)) 

(FKSYMBLOCK  FKSYM  FKSYMP  FKSYMPUT  GETRADIX50  (NOLINKFNS  .  T) 
(ENTRIES  FKSYM  FKSYMP  FKSYMPUT)) 

(FKJSYSBLOCK  FKJSYS  FKJSYSARG  (NOLINKFNS  .  T) 

(ENTRIES  FKJSYS)))) 

[DECLARE:  DONTEVAL0LOAD  DOEVAL0COMPILE  DONTCOPY 

(BLOCK:  FKCALLBLOCK  FKCALL  FKCATYPE  FKSR  SAILCALL  SAILARG  SAILSTRING 
FKACS  FKACSRETURN  FKRTN  (NOLINKFNS  .  T) 

(ENTRIES  FKCALL  SAILCALL  FKCATYPE  FKACS  FKACSRETURN)) 

(BLOCK:  FKARRAYBLOCK  FKARRAY  FKCORGET  FKELT  FKELTI  FKELTR  FKSETA 
FKARRAYP  FKBCHECK  FKARRADR  FKFLOAT  (NOLINKFNS  .  T) 

(ENTRIES  FKARRAY  FKELT  FKELTI  FKELTR  FKSETA  FKARRAYP  FKFLOAT)) 
(BLOCK:  FKSYMBLOCK  FKSYM  FKSYMP  FKSYMPUT  GETRADIX50  (NOLINKFNS  .  T) 
(ENTRIES  FKSYM  FKSYMP  FKSYMPUT)) 

(BLOCK:  FKJSYSBLOCK  FKJSYS  FKJSYSARG  (NOLINKFNS  .  T) 

(ENTRIES  FKJSYS)) 

1 

(DECLARE:  DONTEVAL8LOAD  DOEVAL8COMPILE  DONTCOPY  COMPILERVARS 

i 
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( ADDTOVAR  NLAHA  SAILCALL  FKCALL) 

( ADDTOVAR  NLAML  FKSETVAL  FKVALI  FKVALR  FKVAL  FKSETA  FKELTR  FKELTI  FKELT 

FKARRAY  FKX  FKINIT) 

) 

(DECLARE:  DONTCOPY 

(FILEMAP  (MIL  (1295  37331  (FKINIT  1307  .  5060)  (FKKILL  5064  .  5982)  ( 
FKSAVE  5S86  .  6375)  ( FKDDT  6379  .  7661)  (FKCALL  7665  .  11545)  (FKCATYPE 
11549  .  11870)  (FKSR  11874  .  12612)  (SAILCALL  12616  .  15106)  (SAILARG 
15110  .  18208)  (SAILSTRING  18212  .  18853)  (FKACS  18857  .  19041)  ( 
FKACSRETURN  19045  .  19159)  (FKRTN  19163  .  19479)  (NOFORK  19483  .  19606) 
(FKCALLERR  19610  .  19701)  (FKSW  19705  .  20590)  (FKX  20594  .  20686)  ( 
FKTTYSET  20690  .  21667)  (FKARRAY  21671  .  24128)  (FKCORGET  24132  .  24466) 
(FKELT  24470  .  24708)  (FKELTI  24712  .  25073)  (FKELTR  25077  .  25443)  ( 
FKSETA  25447  .  25851)  (FKARRAYP  25855  .  26061)  (FKARRAYSIZE  26065  . 
26135)  (SAILARRAYSIZE  26139  .  26444)  ( FKARRAYTYPE  26448  .  26722)  ( 
FKBCHECK  26726  .  26845)  (FKARRADR  26849  .  28129)  (FKFLOAT  28133  .  28250) 
(ARRLOC  28254  .  28406)  (FKVAL  28410  .  28571)  (FKVALR  28575  .  28689)  ( 
FKVALI  28693  .  30236)  (FKSETVAL  30240  .  31842)  (FKSYM  31846  .  32550)  ( 
FKSYMPUT  32554  .  32763)  (FKSYMP  32767  .  32813)  (GETRADIX50  32817  .  33686 
)  (FKTIME  33690  .  34359)  (FKJSYS  34363  .  35888)  (FKJSYSARG  35892  .  36645 
)  (FKWAIT  36649  .  37328))))) 

STOP 
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(FILECREATED  "  7-Aug-79  19:03:11"  <RBECHTAL>HASHER. . 38  8393 


changes  to:  GETSH 

previous  date:  "  6-Aug-79  14:37:00"  <RBECHTAL>HASHER. .37) 


(PRETTYCOMPRINT  HASHERCOMS) 

( RPAQQ  HASHERCOMS  ((VARS  *  HASHERVARS) 

(FNS  *  HASHERFNS) ) ) 

(RPAQQ  HASHERVARS  (MEMORY  MEMSIZE  MEMLIMIT  MEMFACTOR) ) 

(RPAQQ  MEMORY  NIL) 

(RPAQQ  MEMSIZE  256) 

(RPAQQ  MEMLIMIT  0) 

(RPAQQ  MEMFACTOR  0) 

(RPAQQ  HASHERFNS  (ADDH  CREATH  FASTHAK  GETH  GETSH  GETSTRIP  LOCH  MAPH 

MEMDENSITY  MEMTEST  NEWHASH  NEXTH  PREHASH  PUTH 
PUTSH) ) 

(DEFINEQ 

188) 

(ADDH 

[LAMBDA  (ARGS  NEWVAL)  (*  edited: 

"  6-Aug-79  13:51")  I 

(*  ADDH  is  really  no  longer  necessary  -  I 

PUTSH  does  the  same  job  now.)  I 


(PUTSH  ARGS  NEWVAL] ) 


[891 


(CREATH 

[LAMBDA  (SIZE)  (*  edited: 

"  6-Aug-79  13:58") 

(*  CREATH  creates  an  array,  called  MEMORY,  of  the 
size  specified  by  the  argument  given  to  CREATH. 

This  array  will  be  treated  as  a  hash  array,  and  is 
used  to  store  the  assertion  retrieval  information.) 


(SETQ  MEMORY  (ARRAY  SIZE)) 

(SETQ  MEMSIZE  SIZE) 

(SETQ  MEMFACTOR  (ADD1  (IQUOTIENT  (LOG  SIZE) 

5))) 


(SETQ  MEMFILLED  0) 
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(SETQ  MEMFULLSIZE  ( IQUOTIENT  (ITIMES  SIZE  4) 

51) 


[901 


(FASTHAK 

[LAMBDA  NIL 


(MAPH  MEMORY  MEMSIZE  (FUNCTION  MEMTEST] ) 


(*  edited: 

"  6-Aug-79  13:59")  I 
(*  FASTHAK  provides  a  I 
way  to  look  at  the  I 
contents  of  MEMORY.)  I 


[91] 


(GETH 

[LAMBDA  (ARGS) 
0 


(*  edited: 

"  6-Aug-79  14:01") 


(*  GETH  retrieves  the  CDR  of  the  element  of  the 
array  whose  CAR  contains  ARGS.) 


(ELTD  MEMORY  (LOCH  ARGS]) 


[921 


(GETSH 

[LAMBDA  (ARGS) 


(*  edited: 

"  7 -Aug-7 9  19:03") 


(*  GETSH  is  insured  to  return  a  stream. 
It's  not  unlike  GETH,  but  will  create 
(and  store)  a  stream  if  necessary.) 


(OR  (GETH  ARGS) 

(PUTH  (APPEND  ARGS) 
(NEWSTREAM] ) 


(*  The  APPEND  is  I 
necessary  because  I 
RETSTREAM  reuses  a  I 
scratchlist)  I 


I 

[931 


(GETSTRIP 

[LAMBDA  (ARGS) 


(STRIPSTREAM  (GETH  ARGS]) 


(*  edited: 

"  6-Aug-79  14:04")  I 
(*  GETSTRIP  returns  a  I 
list  of  assertions  which 
match  ARGS.)  I 


ijm*- 
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(LOCH 

[LAMBDA  (ARGS  PUTFLG)  (*  edited: 

"  6-Aug-79  14:08") 

(*  LOCH  generates  a  location  in  MEMORY  whose  CAR  is 
ARGS.  This  may  involve  moving  down  in  the  case  of 
collisions.  PUTFLG  signals  that  the  indexing  is  for 
insertion  (so  that  erased  locations  can  be  reused).) 


(PROG  (LOC  CONT) 

(SETQ  LOC  (PREHASH  ARGS)) 

(SETQ  MEMTESTCNT  1) 

GLOOP 

(SETQ  CONT  (ELT  MEMORY  LOC)) 

(COND 

([OR  (EQUAL  CONT  ARGS) 

(NULL  CONT) 

(AND  PUTFLG  (EQ  CONT  (QUOTE  *erased*] 

(RETURN  LOC)) 

(T  (SETQ  LOC  (NEXTH  LOC  ARGS)) 

(SETQ  MEMTESTCNT  (ADD1  MEMTESTCNT)) 

(GO  GLOOP]) 

[951 

(MAPH 

[LAMBDA  (ARY  ARYSZ  ARYFN)  (*  edited: 

"  6-Aug-79  14:09")  I 

(*  MAPH  maps  ARYFN,  a  function  of  two  arguments,  I 

over  the  array  ARY,  which  has  size  ARYSZ.  I 

Used  by  MEMTEST  and  NEWHASH.)  I 


(PROG  ((COUNT  1) 

CONTENT) 

MPLOOP 

(COND 

((GREATERP  COUNT  ARYSZ) 

(RETURN) ) ) 

[COND 

((ELT  ARY  COUNT) 

(APPLY*  ARYFN  (ELT  ARY  COUNT) 
(ELTD  ARY  COUNT] 

(SETQ  COUNT  (ADD1  COUNT)) 

(GO  MPLOOP]) 


[961 


(MEMDENSITY 
(LAMBDA  NIL 


(*  edited: 

"  6-Aug-79  14:22")  I 
(*  MEMDENSITY  calculates 
how  full  MEMORY  is.)  i 
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(PRIN1  "memory  is  ") 

(PRIN1  (FTIMES  100.0  (FQUOTIENT  MEMFILLED  MEMSIZE))) 
(PRIN1  "  percent  full.") 

(TERPRI) 

(PRIN1  MEMFILLED) 

(PRIN1  "  out  of  ") 

(PRIN1  MEMSIZE) 

(PRIN1  "  spaces  are  in  use.") 

(TERPRI] ) 


197] 


(MEMTEST 

[LAMBDA  (X  Y)  (*  edited: 

"  6-Aug-79  14:29") 

(*  MEMTEST  prints  useful  information  about  the 
contents  of  MEMORY.  However,  if  there's  a  lot  in 
memory,  it  gets  very  dull.) 


(COND 

((NOLL  X)) 

(T  (PRIN1  COUNT) 

(PRIN1  "  ") 

(PRIN1  X) 

(PRIN1  "  n) 

(PRIN1  (CAAR  Y)) 

(PRIN1  "  ")  I 

(PRIN1  (LENGTH  (CADR  Y) ) )  I 

(TERPRI) ) 

[981 

(NEWHASH 

[LAMBDA  NIL  (*  edited: 

"  6-Aug-79  14:30")  I 

(*  NEWHASH  creates  a  new 

hash  array.  Effectively 
a  dynamic  expansion  of  I 

MEMORY.)  I 

(PROG  ((A  MEMORY) 

(OLDSIZE  MEMSIZE)) 

(CREATH  (PLUS  MEMSIZE  (IQUOTIENT  MEMSIZE  2))) 

(MAPH  A  OLDSIZE  (FUNCTION  (LAMBDA  (LEFT  RIGHT) 

(COND 

[(OR  (NULL  LEFT) 

(EQ  LEFT  (QUOTE  *erased*) 

(T  (PUTH  LEFT  RIGHT)) 

199) 

( NEXTH 

[LAMBDA  (LOC  ARG)  (*  edited: 

"  6-Aug-79  14:32")  I 

I 

(*  NEXTH  generates  a  new  address  in  the  case  of  I 
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collisions.  It’s  a  simple  "move  down",  with  the 
increment  selected  to  be  relatively  prime  to  an 
reasonable  array  size  (preventing  wraparound) ,  and 
widely  spaced.) 


(PROG  (NEWLOC) 

(SETQ  NEWLOC  (IDIFFERENCE  LOC  659)) 

NXTLP 

(COND 

((GREATERP  1  NEWLOC) 

(SETQ  NEWLOC  (IPLUS  MEMSIZE  NEWLOC)) 
(GO  NXTLP)) 

(T  (RETURN  NEWLOC]) 


[100] 


(PREHASH 

[LAMBDA  (L)  (*  edited: 

"  6-Aug-79  14:33") 

(*  PREHASH  generates  an  address  given  a  retrieval 
spec.  It  is  the  primary  hashing  function.) 


(PROG  (C  N) 

(SETN  PREHASHSUM  0) 

OUTER 

(SETN  PREHASHSUM1  0) 

(SETQ  N  3) 

INNER 

[COND 

((NULL  L) 

(RETURN  (ADD1  (IREMAINDER  (IPLUS  PREHASHSUM  PREHASHSUM1) 

MEMSIZE] 

(SETQ  C  (CAR  L)) 

(SETN  PREHASHSUM1  (IPLUS  (LSH  PREHASHSUM1  8) 

(LOGAND  (COND 

((LITATOM  C) 

(LOC  C)) 

( (NUMBERP  C) 

(LOC  (VAG  C))) 

( (STRINGP  C) 

(LOC  ( MKATOM  C) ) ) 

( (LISTP  C) 

(PREHASH  C)) 

(T  (HELP 

"BAD  ARG  -  PREHASH"))) 
255))) 

(SETQ  L  (CDR  L)  ) 

(SETQ  N  (SUB1  N)) 

(COND 

((ZEROP  N) 

(SETN  PREHASHSUM  (IPLUS  PREHASHSUM  PREHASHSUMl) ) 

(GO  OUTER))) 

(GO  INNER]) 
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(PUTH 

[LAMBDA  (ARGS  AVAL)  (*  edited: 

"  6-Aug-79  14:34")  I 

(*  PUTH  sticks  things  in 

MEMORYr  expanding  if  I 

necessary.)  I 

(COND 

( ( IGREATERP  MEMFILLED  MEMFULLSIZE) 

(NEWHASH) ) ) 

(SETQ  MEMFILLED  (ADD1  MEMFILLED)) 

(PROG  ((LOC  (LOCH  ARGS  T) ) ) 

(SETA  MEMORY  LOC  ARGS) 

(SETD  MEMORY  LOC  AVAL) 

(RETURN  AVAL)) 

[1021 


(PUTSH 

[LAMBDA  (ARGS  AVAL) 


(PUTSTREAM  (GETSH  ARGS) 
AVAL)) 


(*  edited: 

"  6-Aug-79  14:36")  I 
(*  PUTSH  places  AVAL  in 
the  stream  associated  I 
with  ARGS)  I 


(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (555  8369  (ADDH  567  .  852)  (CREATH  856  .  1477)  (FASTHAK 
1481  .  1766)  (GETH  1770  .  2069)  (GETSH  2073  .  2548)  (GETSTRIP  2552  . 
2820)  (LOCH  2824  .  3617)  (MAPH  3621  .  4226)  (MEMDENSITY  4230  .  4790)  ( 
MEMTEST  4794  .  5326)  (NEWHASH  5330  .  5859)  (NEXTH  5863  .  6522)  (PREHASH 
6526  .  7616)  (PUTH  7620  .  8085)  (PUTSH  8089  .  8366))))) 

STOP 
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(PILECREATED  "28-Aug-79  21:06:16"  <RBECHTAL>INTERP. .37  12152 
changes  to:  JUSTBU1LD 

previous  date:  "27-Aug-79  21:31:58"  <RBECHTAL>INTERP. .36) 


( PRETTYCOMPRINT  INTERPCOMS) 


(RPAQQ  INTERPCOMS  [ (FNS  *  INTERPFNS) 

(VARS  (VDRELS  (QUOTE  (LESS-THAN  SAME-AS  GREATER- THAN 1 


) 


(RPAQQ  INTERPFNS  (ANDHACK  APPLYRULE  CONSTRUCT  GETPULSAR  JUSTBUILD 

MASSAGE1  NOTHACK  ORACLEHACK  ORBUILD  ORHACK 
SAVEPULSAR  SWEEPER  UNLESSHACK  VAR?)) 

(DEFINEQ 


(1031 


(ANDHACK 

[LAMBDA  (CONDITIONS  ACTIONS  EV)  (*  edited: 

"  7 -Aug-7 9  10:12") 

(*  ANDHACK  handles  anded  conditions 
(those  without  special  modifiers).  An  AND  is  true 
(succeeds)  if  the  confidence  in  the  assertion  it 
finds  is  greater  than  .1  (an  arbitrary  threshold). 

Like  all  of  the  other  hacksr  ANDHACK  relies  on 
MAPRETR I EVE  to  do  the  real  work. 

Oracles  are  evaluated  first,  so  that  their  results 
will  exist  in  the  network  for  the  MAPRETRIEVE  to 
find.) 


(ORACLEHACK  (CAR  CONDITIONS)) 

(MAPRETRIEVE  (CAR  CONDITIONS) 

(LIST  (CDR  CONDITIONS) 

ACTIONS  EV) 

(FUNCTION  (LAMBDA  (X  P) 

(PROG  ((CLIST  (CAR  P) ) 

(ACTIONS  (CADR  P) ) 

(EV  (CADDR  P))) 

(COND 

((GREATERP  (GETCON  X) 

.1) 

(SWEEPER  CLIST  ACTIONS  (CONS  X  EV) ) 
(RETURN  Tl) 


[1041 


(APPLYRULE 

[LAMBDA  (RULENAME  PREBIND) 


(*  edited: 
"19-Jul-79  14:43") 


(*  APPLYRULE  is  the  function  that  starts  all  of  the 


1 
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work  of  the  rule  interpreter. 

When  APPLYRULE  is  called  on  a  rule,  it  starts  the 
process  of  mapping  retrieval  functions  over  the  data 
base  based  on  the  conditions  of  the  rule. 

Binding  of  variables  is  accomplished  in  this  version 
by  rewriting  the  remaining  conditions  with  the 
bindings  substituted  for  the  variables.) 


(SWEEPER  (SUBLIS  PREBIND  (GETPROP  RULENAME  (QUOTE  CONDITIONS)))  I 

(SUBLIS  PREBIND  (GETPROP  RULENAME  (QUOTE  ACTIONS)))  I 

(CONS  RULENAME]) 


[1051 

(CONSTRUCT 

[LAMBDA  (ACTIONS  EV  COUNT) 

(PROG  (FIRST) 

(*  CONSTRUCT  is  the  function  that  steps  through  the 
actions  of  a  rule  and  passes  them  to  the  appropriate 
conclusion  building  functions.) 


(*  edited: 
"27-Aug-79  11:47") 


(OR  COUNT  (SETQ  COUNT  1))  I 

CLOOP 

(COND 

((NULL  ACTIONS) 

(RETURN  T)) 

(T  (SETQ  FIRST  (CAR  ACTIONS)) 

(COND 

((EQ  (CAR  FIRST) 

(QUOTE  *OR*) ) 

(ORBUILD  (CDR  FIRST) 

EV)  ) 

((EQ  (CAR  FIRST) 

(QUOTE  *REPORT*) ) 

(SETQ  RESULTLIST  (CONS  (MAS SAG El  FIRST) 

RESULTLIST) ) ) 

(T  (JUSTBUILD  FIRST  EV  COUNT)))  I 

(SETQ  ACTIONS  (CDR  ACTIONS) ) 

(GO  CLOOP]) 

[106] 

(GETPULSAR 

[LAMBDA  (NODE)  (*  edited: 

"  7-Aug-79  10:14")  t 

I 

(*  GETPULSAR,  as  its  name  suggests,  gets  the  pulsar  I 

(if  any)  associated  with  a  node.  I 

Isolating  this  as  a  function  allows  redesign  of  I 

pulsar  storage  with  minimal  rewriting.)  I 


(GETPROP  NODE  (QUOTE  PULSAR]) 
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1107] 


(JUSTBUILD 

[LAMBDA  (SPEC  EV  NUMBER)  (*  edited: 

"28-Aug-79  21:06") 

(PROG  (NEWNODE  NEWFLG  MASSAGESPEC)  I 

(*  This  is  the  function  that  actually  builds 
conclusions  in  the  assertion  memory,  or  data  base. 

Because  of  the  immediacy  of  the  stream  coroutines, 
it  is  necessary  to  build  the  derivation  tree  before 
actually  adding  the  new  assertion  to  the  memory, 
lest  the  new  assertion  be  used  for  some  rule  without 
having  its  confidence  calculable.) 


(SETQ  MASSAGESPEC  (MAS SAG El  SPEC))  I 

[SETQ  NEWNODE  (COND 

((CAR  (GETSTRIP  MASSAGESPEC) ) )  I 

(T  (SETQ  NEWFLG  (GENSYMl 
(SETQ  RESULTLIST  (CONS  NEWNODE  RESULTLIST) ) 

[PUTPROP  NEWNODE  (QUOTE  DERIVE*) 

(CONS  (REVERSE  EV) 

(GETPROP  NEWNODE  (QUOTE  DERIVE*] 

ICOND 

(NEWFLG  (SET  NEWNODE  MASSAGESPEC)  I 

(SETQ  ASSERTIONS  (CONS  NEWNODE  ASSERTIONS)) 
(SAVEPULSAR  NEWNODE) 

(SERT  (MAS SAG El  SPEC) 

NEWNODE) ) 

(T  (PULSE  (GETPULSAR  NEWNODE] 

(RETURN  NEWFLG]) 

[108] 

(MASS AG El 

[LAMBDA  (SPECLIST)  (*  edited: 

■  7 -Aug-79  10:17")  I 

(*  MASSAGE1  takes  a  condition  I 

(or  action)  and  binds  its  variables  to  their  I 

interpreter  values.  GETMRVAL  I 

(called  by  MASSAGED  has  since  been  extended  to  deal  I 

with  lists  as  well  as  atoms,  so  that  calls  to  I 

MAS SAG El  could  be  directly  replaced  with  calls  to  I 

GETMRVAL.)  I 


( MAPCAR  SPECLIST  (FUNCTION  (LAMBDA  (X) 
(COND 

( (VAR?  X) 

(GETMRVAL  X)) 

(T  XD 
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(NOTHACK 

[LAMBDA  (CONDITIONS  ACTIONS  EV)  (*  edited: 

"  7 -Aug-7 9  10:18") 

(*  NOTHACK  requires  a  confidence  less  than  -.1  to 
continue  the  rule  evaluation. 

General  comments  about  the  connective  hacks  apply.) 


(ORACLEHACK  (CADAR  CONDITIONS)) 

(MAPRETRIEVE  (CADAR  CONDITIONS) 

(LIST  (CDR  CONDITIONS) 

ACTIONS  EV) 

(FUNCTION  (LAMBDA  (X  P) 

(PROG  ((CLIST  (CAR  P) ) 

(ACTIONS  (CADR  P) ) 

(EV  ( CADDR  P))) 

(COND 

( (LESSP  (GETCON  X) 

-.1) 

(SWEEPER  CLIST  ACTIONS 

(CONS  (LIST  (QUOTE  NOT) 

X) 

EV)  ) 

(RETURN  T)) 

[1101 

(ORACLEHACK 

[LAMBDA  (SPEC)  (*  edited: 

"  7 -Aug-79  10:21")  I 

(*  ORACLEHACK  deals  with  oracular  conditions.  I 

Firsts,  it  tests  for  the  presence  of  an  oracle.  I 

If  one  is  found,  it  then  checks  the  data  base  to  see  I 

if  it  has  already  been  computed.  I 

If  not,  it  computes  the  oracle,  and  places  the  I 

result  in  the  memory,  where  it  can  be  used  by  the  I 

normal  condition  evaluation  procedure.  I 

Computation  is  restricted  to  oracles  with  LASTARG  on  I 

their  property  list  under  the  property  name  ORTYPE.  I 

Such  oracles  bind  their  last  argument.)  I 


(PROG  (PTR  LAST-ARG  LASTCONS  ANS  ORTYPE) 

(COND 

((GETPROP  (CAR  SPEC) 

(QUOTE  ORACLE)) 

(SETQ  SPEC  (GETMRVAL  SPEC  T) ) 

(SETQ  ORTYPE  (GETPROP  (CAR  SPEC) 

(QUOTE  ORTYPE))) 

(SELECTQ  ORTYPE 

[LASTARG  (SETQ  LASTCONS  (LAST  SPEC)) 
(SETQ  PTR  (NLEFT  SPEC  2)) 
(SETQ  LAST-ARG  (CADR  PTR)) 


M»in  »i  'i'"’-  ♦  ■" -  -  -  ■ 


| 
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(RPLACD  PTR  NIL) 

(SETQ  ANS  (APPLY  (CAR  SPEC) 

(CDR  SPEC))) 

(COND 

((OR  (VAR?  LAST-ARG) 

(EQUAL  LAST-ARG  ANS)) 

(NCONC  PTR  ( RPLACA  LASTCONS  ANS)) 
(CASSERT  SPEC  1.0] 

(COND 

((APPLY  (CAR  SPEC) 

(CDR  SPEC)) 

(CASSERT  SPEC  1.0)) 

(T  (CASSERT  SPEC  -1.03) 


till] 


(ORBUILD 

[LAMBDA  (SPEC  EV) 
(PROG  (COUNT) 


(*  edited: 
"27-Aug-79  11:49") 


(*  ORBUILD  constructs  disjunctive  conclusions  by 
repeated  calls  to  JUSTBUILD. 

At  present,  no  provision  is  made  to  divide 
confidences  among  the  ORed  conclusions.) 


(SETQ  COUNT  (LENGTH  SPEC)) 

OLOOP 

(COND 

((NULL  SPEC) 

(RETURN) ) 

(T  (CONSTRUCT  (CAR  SPEC)  I 

EV  COUNT)  I 

(SETQ  SPEC  (CDR  SPEC)) 

(GO  OLOOP]) 

[112] 


(ORHACK 

[LAMBDA  (CONDITIONS  ACTIONS  EV)  (*  edited: 

"19-JU1-79  19:21") 

(*  This  handles  disjuctive  conditions  by  re-writing 
them  as  multiple  rules.  There  is  probably  a  problem 
with  the  handling  of  the  confidence  here,  as  no 
effort  is  made  to  correct  the  confidence  for  the 
split. ) 


(for  TEMP2  in  (CDAR  CONDITIONS)  do  (SWEEPER  (CONS  (CAR  TEMP2) 

(CDR  CONDITIONS)) 
ACTIONS  EV]) 
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( SAVEPULSAR 

[LAMBDA  (NODE)  (*  edited: 

"  7 -Aug-7 9  10:25") 

(*  SAVEPULSAR  saves  a  pulsar  on  a  node. 

If  the  method  of  storing  pulsars  should  change,  the 
modularity  of  SAVEPULSAR  and  GETPULSAR  insure  that 
they  are  the  only  functions  that  need  to  be  changed, 
since  all  pulsar  access  is  done  through  them.) 


(PUTPROP  NODE  (QUOTE  PULSAR) 
(PULSAR] ) 


[114] 


(SWEEPER 

[LAMBDA  (CONDITIONS  ACTIONS  EV) 
(PROG  (THISCOND  C) 


(*  edited: 
"27-Aug-79  21:31") 


(*  SWEEPER,  which  is  where  the  work  used  to  get 
done,  now  is  merely  a  big  switch  which  determines 
the  appropriate  condition  handling  function  to  call. 
The  functions  generated  by  these  condition  handlers 
and  FUNCTIONWRITER  will  then  call  SWEEPER 
recursively. ) 


[COND 

((NULL  CONDITIONS) 

(RETURN  (CONSTRUCT  ACTIONS  EV) ) ) 

(T  (SETQ  THISCOND  (CAAR  CONDITIONS] 

(COND 

( (MEMB  THISCOND  VDRELS) 

(AND  (APPLY  THISCOND  (GETMRVAL  (CDAR  CONDITIONS))) 
(SWEEPER  (CDR  CONDITIONS) 

ACTIONS  EV) ) ) 

((EQ  THISCOND  (QUOTE  *OR*) ) 

(ORHACK  CONDITIONS  ACTIONS  EV) ) 

KEQ  THISCOND  (QUOTE  *NOT*)  ) 

(SETQ  C  (CADAR  CONDITIONS)) 

(COND 

((MEMB  (CAR  C) 

VDRELS) 

(OR  (APPLY  (CAR  C) 

(GETMRVAL  (CDR  C) ) ) 

(SWEEPER  (CDR  CONDITIONS) 

ACTIONS  EV))) 

(T  (NOTHACK  CONDITIONS  ACTIONS  EV] 

((EQ  THISCOND  (QUOTE  *UNLESS*) ) 

(UNLESSHACK  CONDITIONS  ACTIONS  EV) ) 

(T  (ANDHACK  CONDITIONS  ACTIONS  EV] ) 


<RBECHTAL>INTERP. .37 


Page  62 
[115] 


(UNLESSHACK 

[LAMBDA  (CONDITIONS  ACTIONS  EV)  (*  edited: 

"  7-Aug-79  10:30") 

(*  UNLESSHACK  is  the  connective  hack  that  deals  with 
UNLESS  conditions.  While  the  general  comments  about 
hacks  apply  to  UNLESSHACK,  it  is  quite  different  in 
that  it  expects  to  find  its  assertion  in  the  memory, 
adding  it  (with  confidence  0.0)  if  necessary. 

Since  UNLESSes  succeed  if  the  confidence  in  their 
assertion  is  0.0  or  less,  adding  an  assertion  to 
memory  in  UNLESS  forces  the  condition  to  succeed. 
UNLESSes  are  only  blocked  if  information 
(with  positive  confidence)  already  exists  in  the 
network.  Given  the  parallel  rule  application,  this 
feature  can  create  problems  unless  care  is  taken  in 
rule  construction.  This  problem  will  be  discussed 
further  in  later  working  papers.) 


(ORACLEHACK  (CADAR  CONDITIONS)) 

(COND 

[ (STRIPSTREAM  (RETSTREAM  (CADAR  CONDITIONS] 

(T  (CASSERT  (MAS SAG El  (CADAR  CONDITIONS)) 

0.0))) 

( MAPRETR I EVE  (CADAR  CONDITIONS) 

(LIST  (CDR  CONDITIONS) 

ACTIONS  EV) 

(FUNCTION  (LAMBDA  (X  P) 

(PROG  ((CLIST  (CAR  P) ) 

(ACTIONS  (CADR  P) ) 

(EV  ( CADDR  P))) 

(COND 

( (LEQ  (GETCON  X) 

0.0) 

(SWEEPER  CLIST  ACTIONS 

(CONS  (LIST  (QUOTE  UNLESS) 

X) 

EV)  ) 

(RETURN  T]  ) 

[116] 

(VAR? 

[LAMBDA  (Q)  (*  edited: 

"ll-May-79  C..46")  I 

I 

(*  VAR?  tests  to  see  if  an  atom  is  in  variable  I 

format.  Variables  start  with  an  asterisk.)  I 


(EQ  (CHCONl  Q) 
42]) 

) 
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(RPAQQ  VDRELS  (LESS-THAN  SAME- AS  GREATER- THAN ) ) 

(DECLARES  DONTCOPY 

(FILEMAP  (NIL  (462  12077  (ANDHACK  474  .  1502)  (APPLYRULE  1506  .  2184)  ( 
CONSTRUCT  2188  .  2953)  (GETPULSAR  2957  .  3386)  (JUSTBUILD  3390  .  4509)  ( 
MASS AG El  4513  .  5148)  (NOTHACK  5152  .  5903)  (ORACLEHACK  5907  .  7358)  ( 
ORBUILD  7362  .  7898)  (ORHACK  7902  .  8464)  (SAVEPULSAR  8468  .  8995)  ( 
SWEEPER  8999  .  10184)  (UNLESSHACK  10188  .  11766)  (VAR?  11770  .  12074)))) 

) 


<RB ECHTAL  >MAN I PUL ATS . .20 


Page  64 


(FILECREATED  "  6-Aug-79  17:32:02"  <RBECHTAL>MANIPULATE. .20  8876 


changes  to:  ASSERT  BUMP  CASSERT  DENY  GETUPLE  MATCHER  MAYBE 
RETRIEVER  RETVARS  SERT  STATE 


previous  date:  "19-Jul-79  15:45:55"  <RBECHTAL>MANIPULATE. .19) 


(PRETTYCOMPRINT  MANIPULATECOMS) 

(RPAQQ  MANIPULATECOMS  I (FNS  *  MANIPULATEFNS) 

(DECLARE:  DONTEVAL0LOAD  DOEVAL8COMPILE  DONTCOPY 
COMPILERVARS 

(ADDVARS  (NLAMA  STATE  MAYBE  DENY) 
(NLAML) 

(LAMA] ) 


(RPAQQ  MANIPULATEFNS  (ASSERT  BUMP  CASSERT  DENY  GETUPLE  MATCHER  MAYBE 

RETRIEVER  RETVARS  SERT  STATE) ) 


(DEFINEQ 


1117] 


(ASSERT 

[LAMBDA  (ARGLIST  NODENAME)  (*  edited: 

"  6-Aug-79  17:03") 

(*  ASSERT  creates  an  assertion  and  places  it  in 
memory,  keyed  by  the  appropriate  retrieval 
specifications.  ASSERT  makes  no  statement  regarding 
the  confidence  in  the  assertion,  and  thus  should  be 
used  with  the  greatest  caution,  to  avoid  fouling 
rules.  ASSERT  takes  one  argument,  a  list,  which  it 
evaluates. ) 


(PROG  (REPLY  LEN  A) 

[COND 

((GETSTRIP  ARGLIST) 

(RETURN  (CAR  (GETSTRIP  ARGLIST] 

[SETQ  REPLY  (COND 
(NODENAME) 

(T  (GENSYM] 

(SETQ  ASSERTIONS  (CONS  REPLY  ASSERTIONS)) 
(SET  REPLY  ARGLIST) 

(SAVEPULSAR  REPLY) 

(SERT  ARGLIST  REPLY) 

(RETURN  REPLY]) 


[1181 


(BUMP 

[LAMBDA  (L)  (*  edited: 

"  6-Aug-79  17:04")  I 

I 

(*  BUMP  counts  in  binary,  using  a  list  of  Ts  and  I 
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NILS  in  place  of  Is  and  Os.  Given  a  list  of  Ts  and 
NILS,  returns  a  list  of  Ts  and  NILs  that  is  "plus  one" 
of  its  argument.) 


(PROG  (ANS) 

BLOOP1 

ICOND 

((NULL  L) 

(RETURN  (DREVERSE  ANS))) 
((CAR  L) 

(SETQ  ANS  (CONS  NIL  ANS)) 
(SETQ  L  (CDR  L) ) 

(GO  BLOOP1) ) 

(T  (SETQ  ANS  (CONS  T  ANS)) 
(SETQ  L  (CDR  L) 

BLOOP2 

(COND 

( (NULL  L) 

(RETURN  (DREVERSE  ANS))) 
(T  (SETQ  ANS  (CONS  (CAR  L) 

ANS)  ) 

(SETQ  L  (CDR  L) ) 

(GO  BLOOP2 ] ) 


[119] 


(CASSERT 

[LAMBDA  (SPEC  VAL)  (*  edited: 

"  6-Aug-79  17:08") 

(*  CASSERT  works  like  ASSERT,  only  it  establishes  a 
confidence  in  the  assertion  it  creates. 

CASSERT  takes  two  arguments. 

The  first  is  taken  to  be  the  assertion  spec,  and  the 
second  the  confidence  in  the  assertion. 

If  the  confidence  argument  is  positive,  it  is  used 
as  the  measure  of  belief  in  the  assertion,  and  if 
negative,  it  is  used  as  the  measure  of  disbelief. 
Whichever  measure  is  not  specified  is  set  to  zero.) 


(PROG  (NEWNODE) 

[COND 

((GETSTRIP  SPEC) 

(RETURN  (CAR  (GETSTRIP  SPEC] 

(SETQ  NEWNODE  (GENSYM) ) 

(SETQ  ASSERTIONS  (CONS  NEWNODE  ASSERTIONS)) 
(COND 

((GREATERP  VAL  0.0) 

(PUTPROP  NEWNODE  1  QUOTE  MB) 

VAL) 

(PUTPROP  NEWNODE  (QUOTE  MD) 

0.0)  ) 

(T  (PUTPROP  NEWNODE  (QUOTE  MB) 

0.0) 

(PUTPROP  NEWNODE  (QUOTE  MD) 
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(ABS  VAL] 

(SET  NEWNODE  SPEC) 

(SAVEPULSAR  NEWNODE) 

(SERT  SPEC  NEWNODE) 

(RETURN  NEWNODE)) 

(1201 

(DENY 

[ NLAMBDA  L  (*  edited: 

"  6-Aug-79  17:10")  I 

(*  DENY  asserts  its  argument  I 

(s)  (unevaluated)  with  confidence  -1.0.  I 

The  most  common  anticipated  use  of  this  function  is  I 

at  top  level  (LISP)  in  APPLY  format,  e.g.  STATE  I 

(PLATFORM  CONTACT3 4) .)  I 


(CASSERT  L  -1.01) 

[1211 

(GETUPLE 

[LAMBDA  (ASSER)  (*  edited: 

"  6-Aug-79  17:11")  I 

I 

(*  Given  an  assertion  node,  GETUPLE  returns  the  I 

tuple  (content)  of  that  node.)  I 


(EVAL  ASSER]) 

[1221 

(MATCHER 

[LAMBDA  (LI  L2)  (*  edited: 

"  6-Aug-79  17:17")  I 

(*  MATCHER  is  used  by  SERT  to  construct  retrieval  I 

specifications  from  assertion  tuples.  I 

MATCHER  takes  two  arguments,  an  assertion  tuple  and  I 

a  "binary  number"  list,  such  as  that  returned  from  I 

BUMP.  Wherever  the  "binary 

number"  list  contains  T,  the  corresponding  element  of  the  I 

assertion  tuple  is  used  in  the  retrieval  I 

specification.  Where  the  BNlist  contains  NIL,  a  *  is  I 

inserted  in  the  retrieval  specification.  I 

The  retrieval  specification  is  returned.)  I 


(PROG  (ANS) 

ML  OOP 

(COND 

((NULL  LI) 

(RETURN  (DREVERSE  ANS))) 
((CAR  LI) 
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(SETQ  ANS  (CONS  (CAR  L2) 

ANS) ) ) 

(T  (SETQ  ANS  (CONS  (QUOTE  *) 

ANSI 

(SETQ  LI  (CDR  LD) 

(SETQ  L2  (CDR  L2)) 

(GO  MLOOP] ) 

[1231 


(MAYBE 

[NLAMBDA  L  (*  edited: 

"  6 -Aug-7 9  17:17")  I 

(*  MAYBE  functions  like 
DENY,  only  gives  a  I 

confidence  of  0.0.)  I 

(CASSERT  L  0.03) 

[124] 


(RETRIEVER 

[LAMBDA  (SPEC)  (*  edited: 

"  6 -Aug-7 9  17:29") 

(*  RETRIEVER  is  the  workhorse  function  that  gets 
stuff  out  of  the  memory.  RETRIEVER  takes  a  single 
argument  list  (evaluated) ,  which  should  be  either  an 
assertion  tuple,  or  an  assertion  tuple  with 
variables  in  some  places.  (A  variable  is  an  atom 
that  starts  with  a  star,  such  as  *PLAT. )  RETRIEVER 
returns  a  list  of  answers,  each  of  the  form 
(assertionnodematched  alist) ,  where  the  alist  is  a 
set  of  CONSES  of  the  variables  together  with  the 
ground  instances  which  they  matched. 

For  example,  (RETRIEVER  (QUOTE 

(SIGHTING  *PLAT  *SNODE) ) )  might  return 

( (A0034  ( *PLAT  .  CONNOLE)  (*SNODE  .  SIGHTING1) ) 

(A0765  ( "PLAT  .  MINSK)  (*SNODE  .  SIGHTING55) ) ) ) 


(PROG  (RES) 

IMAPC  (GETSTRIP  (RETVARS  SPEC)) 

(FUNCTION  (LAMBDA  (W) 

(PROG  (RES1) 

IMAP2C  SPEC  (GETUPLE  W) 

(FUNCTION  (LAMBDA  (A  B) 
(COND 

((VAR?  A) 

(SETQ  RES1 

(CONS  (CONS  A  B) 
RES1I 

(SETQ  RES  (CONS  (CONS  W  RES1) 

RES] 


(RETURN  RES] ) 
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(RETVARS 

[LAMBDA  (SPEC)  (*  edited: 

"  6-Aug-79  17:30")  I 

(*  RETVARS  massages  I 

RETRIEVER  specs  to  turn 
them  into  retrieval  I 

specifications.)  I 

(MAPCAR  SPEC  (FUNCTION  (LAMBDA  (ITEM) 

(COND 

((VAR?  ITEM) 

(QUOTE  *)) 

(T  ITEM]) 

[1261 


(SERT 

[LAMBDA  (SPEC  NODENAME) 
(PROG  (LEN  A) 


(*  edited: 

"  6-Aug-79  16:28") 


(*  SERT  is  the  function  that  actually  stores  the 
assertion  nodes  in  the  memory  under  specifications 
generated  by  MATCHER  with  the  help  of  BUMP. 

In  this  version,  we  are  not  storing  under  retrieval 
specifications  where  the  relation  field  is 
wild-carded.  To  permit  retrieval  of  assertions  with 
the  relation  field  variable 

(binding  the  relation  field),  remove  the  SUB1  and 
the  CONS  of  T  at  SLOOPJB.  Also,  remove  the  ADDH  just 
before  SLOOPJB.) 


(SETQ  LEN  ( SUB1  (LENGTH  SPEC))) 

(SETQ  A  NIL) 

(RPTQ  LEM  (SETQ  A  (CONS  NIL  A))) 

(ADDH  (MATCHER  (CONS  T  A) 

SPEC) 

NODENAME) 

SLOOPJB 

(ADDH  (MATCHER  (CONS  T  (SETQ  A  (BUMP  A))) 

SPEC) 

NODENAME) 

(COND 

( (MEMB  NIL  A) 

(GO  SLOOPJB))) 

(ENDSTREAM  (GETSH  SPEC))  I 

(RETURN  NODENAME]) 

[1271 

( STATE 

[ NLAMBDA  L  (*  edited: 

"  6-Aug-79  17:31")  I 

I 

(*  STATE  works  like  DENY  and  MAYBE,  but  gives  the  I 
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assertion  a  confidence  of  1.0.) 


I 

I 


(CASSERT  L  1.01) 

) 

(DECLARE:  DONTEVAL0LOAD  DOEVAL0COMPILE  DONTCOPY  COMPILERVARS 

(ADDTOVAR  KLAMA  STATE  MAYBE  DEMY) 

(ADDTOVAR  ML AML  ) 

(ADDTOVAR  LAMA  ) 

) 

(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (587  8708  (ASSERT  599  .  1519)  (BUMP  1523  .  2340)  (CASSERT 
2344  .  3601)  (DENY  3605  .  4054)  (GETUPLE  4058  .  4347)  (MATCHER  4351  . 
5391)  (MAYBE  5395  .  5654)  (RETRIEVER  5658  .  7014)  (RETVARS  7016  .  7392) 
(SERT  7396  .  8408)  (STATE  8412  .  8705))))) 

STOP 
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(FILECREATED  "  6-Aug-79  19s06:57"  <RBECHTAL>MEMORY. .17  17907 
previous  date:  "23-Jul-79  08:04:36"  <RBECHTAL>MEMORY. .15) 


(PRETTYCOMPRINT  MEMORYCOMS) 


(RPAQQ  MEMORYCOMS  ((VARS  *  (APPEND  MEMORYVARS  ASSERTIONS)) 

IIFPROP  (DERIVE  DERIVE*  FROM  FROM*  NEGFROM  NEGFROM*  SPLIT  MB  MD) 
* 


(P 


(APPEND  ASSERTIONS  [MAPCAR  ASSERTIONS 

(FUNCTION 

(LAMBDA 

(X) 

(GETPROP  X  (QUOTE  FROM*] 
(MAPCAR  ASSERTIONS  (FUNCTION 
(LAMBDA  (Y) 

(GETPROP  Y  (QUOTE  DERIVE*] 

(CREATH  MEMSIZE) 

(MAPC  ASSERTIONS  (FUNCTION  (LAMBDA  (Q) 

(SERT  (EVAL  Q) 

Q1 

(PRIN1  "Memory  Reinitialized") 

(TERPRI))) ) 


(RPAQQ  MEMSIZE  4374) 
(RPAQQ  GENNUM  10175) 


(RPAQQ  ASSERTIONS  (A0175  A0174 

A0 173 

A0172 

A0171 

A0170 

A0169 

A0168 

A0167 

A0166 

A0165 

A0164 

A0163 

A0162 

A0161 

A0160 

A0159 

A0158 

A0157 

A0156 

A0155 

A0154 

A0 153 

A0 152 

AO  151 

AO  150 

A0149 

A0148 

AO  147 

A0146 

A0 145 

A0144 

AO  143 

AO  142 

A0141 

A0140 

A0139 

A0138 

A0137 

A0136 

AO  13  5 

A0134 

A0133 

A0132 

A0131 

A0130 

A0129 

A0128 

A0127 

AO  126 

A0125 

A0124 

A0123 

A0122 

A0121 

A0120 

A0119 

A0118 

A0117 

AO  116 

A0115 

A0114 

A0113 

A0112 

A0  111 

A0110 

A0109 

A0108 

A0107 

A0106 

A0105 

A0104 

A0 103 

A0102 

A0101 

A0100 

A0099 

A0098 

A0  097 

AO  096 

A0095 

A0094 

A0093 

AO  092 

A0091 

A0  090 

AO  089 

A0088 

AO  087 

AO  086 

AO  085 

AO  084 

A0  083 

A0082 

A0081 

A0080 

A0079 

A0078 

AO  07  7 

A0076 

A0  07  5 

A0074 

AO  07  3 

AO  07  2 

A0071 

AO  070 

A0069 

A0068 

AO  06  7 

A0066 

A0065 

AO  06  4 

A0063 

A0062 

A0061 

A0060 

A0059 

A0058 

AO  057 

A0056 

A0055 

A0  054 

AO  053 

AO  052 

AO  051 

AO  050 

A0049 

A0048 

A0047 

A0046 

AO  04  5 

A0044 

A0043 

A0042 

A0041 

A0040 

AO  03  9 

A0038 

A0037 

A0036 

A0035 

A0034 

A0033 

A0032 

A0031 

/0030 

A0029 

A0028 

A0027 

A0026 

A0025 

A0024 

*0023 

A0022 

A0021 

A0020 

A0019 

A0018 

A0017 

A0016 

A0015) ) 

(RPAQQ  MEMORYVARS  (MEMSIZE  GENNUM  ASSERTIONS  MEMORYVARS  SYMBOLS)) 
(RPAQQ  SYMBOLS  NIL) 
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(RPAQQ  A0175  (CLASS  VIKING  S-3A) ) 

(RPAQQ  AO 17 4  (MEDIUM  VIKING  AIR)) 

(RPAQQ  AO 17 3  (TYPE  VIKING  RECONNISANCE) ) 

(RPAQQ  AO 17 2  ( ID- AMPLIFY  VIKING  MIL-AUXIL) ) 
(RPAQQ  AO 17 1  (ID  VIKING  FRIEND)) 

(RPAQQ  A0170  (PLATFORM  VIKING)) 

(RPAQQ  A0169  (CLASS  SEASPRITE  SH-2F) ) 

(RPAQQ  A0168  (MEDIUM  SEASPRITE  AIR)) 

(RPAQQ  A0167  (TYPE  SEASPRITE  HELICOPTER)) 

(RPAQQ  A0166  ( ID- AMPLIFY  SEASPRITE  MIL-EATTLE) ) 
(RPAQQ  AO 16 5  (ID  SEASPRITE  FRIEND) > 

(RPAQQ  AO 16 4  (PLATFORM  SEASPRITE)) 

(RPAQQ  AO 16 3  (CLASS  ORION  P-3C) ) 

(RPAQQ  A0162  (MEDIUM  ORION  AIR) ) 

(RPAQQ  A0161  (TYPE  ORION  RECONNISANCE)) 

(RPAQQ  A0160  ( ID-AMPLIFY  ORION  MIL-AUXIL)) 
(RPAQQ  AO 159  (ID  ORION  FRIEND)) 

(RPAQQ  A0158  (PLATFORM  ORION)) 

(RPAQQ  AO 157  (CLASS  HORMONE  KA-25) ) 

(RPAQQ  AO 156  (MEDIUM  HORMONE  AIR)) 

(RPAQQ  A0155  (TYPE  HORMONE  HELICOPTER) ) 

(RPAQQ  A0154  (ID-AMPLIFY  HORMONE  MIL-BATTLE)) 
(RPAQQ  AO 153  (ID  HORMONE  HOSTILE)) 

(RPAQQ  AO 152  (PLATFORM  HORMONE)) 

(RPAQQ  AO 151  (CLASS  HAWKEYE  E-2B) ) 

(RPAQQ  AO 150  (MEDIUM  HAWKEYE  AIR)) 

(RPAQQ  A0149  (TYPE  HAWKEYE  RECONNISANCE)) 

(RPAQQ  A0148  (ID-AMPLIFY  HAWKEYE  MIL-AUXIL)) 
(RPAQQ  AO 147  (ID  HAWKEYE  FRIEND)) 
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(RPAQQ 

AO  146 

( RPAQQ 

A0145 

(RPAQQ 

A0144 

(RPAQQ 

A0143 

(RPAQQ 

A0142 

(RPAQQ 

AO  141 

(RPAQQ 

A0140 

(RPAQQ 

A0139 

(RPAQQ 

A0138 

(RPAQQ 

A0137 

(RPAQQ 

A0136 

(RPAQQ 

A0135 

(RPAQQ 

AO  13  4 

(RPAQQ 

A0133 

(RPAQQ 

A0132 

(RPAQQ 

A0131 

(RPAQQ 

A0130 

(RPAQQ 

A0129 

(RPAQQ 

A0128 

(RPAQQ 

AO  127 

(RPAQQ 

AO  126 

(RPAQQ 

A0125 

(RPAQQ 

A0124 

(RPAQQ 

A0123 

(RPAQQ 

A0122 

(RPAQQ 

AOlZl 

(RPAQQ 

A0120 

(RPAQQ 

A0119 

(PLATFORM  HAWKEYE) ) 

(CLASS  HARRIER  AV-8A) ) 

(MEDIUM  HARRIER  AIR)) 

(TYPE  HARRIER  FIGHTER)) 

( ID- AMPLIFY  HARRIER  MIL-BATTLE) ) 
(ID  HARRIER  FRIEND)) 

(PLATFORM  HARRIER)) 

(CLASS  FOXBAT  MIG25)) 

(MEDIUM  FOXBAT  AIR) ) 

(TYPE  FOXBAT  FIGHTER)) 

(ID-AMPLIFY  FOXBAT  MIL-BATTLE)) 
(ID  FOXBAT  HOSTILE)) 

(PLATFORM  FOXBAT)) 

(CLASS  CORSAIR  A-7) ) 

(MEDIUM  CORSAIR  AIR)) 

(TYPE  CORSAIR  FIGHTER)) 
(ID-AMPLIFY  CORSAIR  MIL-BATTLE)) 
(ID  CORSAIR  FRIEND)) 

(PLATFORM  CORSAIR)) 

(CLASS  BACKFIRE  RV-G) ) 

(MEDIUM  BACKFIRE  AIR)) 

(TYPE  BACKFIRE  BOMBER) ) 
(ID-AMPLIFY  BACKFIRE  MIL-BATTLE)) 
(ID  BACKFIRE  HOSTILE)) 

(PLATFORM  BACKFIRE)) 

(CLASS  RATHBURNE  KNOX)) 

(MEDIUM  RATHBURNE  SURFACE)) 

(TYPE  RATHBURNE  FRIGATE)) 


Page 


<RBECHTAL>MEMORY. . 17 

( RPAQQ  AO 11 8  ( ID- AMPLIFY  RATHBURNE  MIL-BATTLE)) 

( RPAQQ  A0117  (ID  RATHBURNE  FRIEND)) 

(RPAQQ  AO 116  (PLATFORM  RATHBURNE)) 

(RPAQQ  A0115  (CLASS  YANK-1  YANKEE)) 

(RPAQQ  A0114  (MEDIUM  YANK-1  SUB)) 

(RPAQQ  A0113  (TYPE  YANK-1  SUB)) 

(RPAQQ  A0112  ( ID- AMPLIFY  YANK-1  MIL-BATTLE)) 
(RPAQQ  A0111  (ID  YANK-1  HOSTILE)) 

(RPAQQ  A0110  (PLATFORM  YANK-1)) 

(RPAQQ  AO 10 9  (CLASS  WAINWRIGHT  BELKNAP)) 

(RPAQQ  AO 10 8  (MEDIUM  WAINWRIGHT  SURFACE)) 

(RPAQQ  A0107  (TYPE  WAINWRIGHT  CRUISER)) 

(RPAQQ  A0106  ( ID- AMPLIFY  WAINWRIGHT  MIL-BATTLE)) 
(RPAQQ  A0105  (ID  WAINWRIGHT  FRIEND)) 

(RPAQQ  A0104  (PLATFORM  WAINWRIGHT)) 

(RPAQQ  A0103  (CLASS  SUNFISH  STURGEON) ) 

(RPAQQ  A0102  (MEDIUM  SUNFISH  SUB) ) 

(RPAQQ  A0101  (TYPE  SUNFISH  SUB)) 

(RPAQQ  A0100  (ID-AMPLIFY  SUNFISH  MIL-BATTLE)) 
(RPAQQ  A0099  (ID  SUNFISH  FRIEND)) 

(RPAQQ  A0098  (PLATFORM  SUNFISH)) 

(RPAQQ  AO 097  (CLASS  PROVORNY  KASHIN) ) 

(RPAQQ  AO 096  (MEDIUM  PROVORNY  SURFACE) ) 

(RPAQQ  AO 095  (TYPE  PROVORNY  DESTROYER) ) 

(RPAQQ  AO 094  (ID-AMPLIFY  PROVORNY  MIL-BATTLE)) 
(RPAQQ  AO 093  (ID  PROVORNY  HOSTILE)) 

(RPAQQ  A0092  (PLATFORM  PROVORNY)) 

(RPAQQ  A0091  (CLASS  MINSK  KIEV) ) 

(RPAQQ  AO 090  (MEDIUM  MINSK  SURFACE)) 


& 

i 
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( RPAQQ 

A0089 

(RPAQQ 

A0088 

(RPAQQ 

AO  087 

(RPAQQ 

AO  086 

(RPAQQ 

A0085 

(RPAQQ 

A0084 

(RPAQQ 

AO  083 

(RPAQQ 

AO  082 

(RPAQQ 

AO  081 

(RPAQQ 

A0080 

(RPAQQ 

A0079 

(RPAQQ 

AO  07  8 

(RPAQQ 

A0077 

(RPAQQ 

AO  07  6 

(RPAQQ 

A0075 

(RPAQQ 

AO  07  4 

(RPAQQ 

A0073 

(RPAQQ 

AO  07  2 

(RPAQQ 

AO  071 

(RPAQQ 

AO  070 

(RPAQQ 

AO  06  9 

(RPAQQ 

AO  06  8 

(RPAQQ 

AO  06  7 

(RPAQQ 

AO  06  6 

(RPAQQ 

AO  06  5 

(RPAQQ 

AO  06  4 

(RPAQQ 

AO  06  3 

(RPAQQ 

A0062 

(TYPE  MINSK  CARRIER)) 

( ID- AMPLIFY  MINSK  MIL-BATTLE)) 

(ID  MINSK  HOSTILE)) 

(PLATFORM  MINSK)) 

(CLASS  MEYERCORD  KNOX) ) 

(MEDIUM  MEYERCORD  SURFACE)) 

(TYPE  MEYERCORD  FRIGATE) ) 

( ID- AMPLIFY  MEYERCORD  MIL-BATTLE)) 
(ID  MEYERCORD  FRIEND)) 

(PLATFORM  MEYERCORD)) 

(CLASS  LAWRENCE  CHAS. ADAMS) ) 
(MEDIUM  LAWRENCE  SURFACE)) 

(TYPE  LAWRENCE  DESTROYER)) 

( ID- AMPLIFY  LAWRENCE  MIL-BATTLE)) 
(ID  LAWRENCE  FRIEND)) 

(PLATFORM  LAWRENCE) ) 

(CLASS  HASSAYAMPA  NEOSHO) ) 

(MEDIUM  HASSAYAMPA  SURFACE) ) 

(TYPE  HASSAYAMPA  OILER)) 

( ID- AMPLIFY  HASSAYAMPA  MIL-AUXIL) ) 
(ID  HASSAYAMPA  FRIEND)) 

(PLATFORM  HASSAYAMPA)) 

(CLASS  HALSEY  LEAHY) ) 

(MEDIUM  HALSEY  SURFACE)) 

(TYPE  HALSEY  CRUISER)) 

( ID-AMPLIFY  HALSEY  MIL-BATTLE)) 

(ID  HALSEY  FRIEND)) 

(PLATFORM  HALSEY)) 
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(RPAQQ  A0061  (CLASS  ECHO-1  ECHOII) ) 

(RPAQQ  A0060  (MEDIUM  ECHO-1  SUB) ) 

(RPAQQ  A0059  (TYPE  ECHO-1  SUB)) 

(RPAQQ  AO 05 8  ( ID- AMPLIFY  ECHO-1  MIL-BATTLE)) 

(RPAQQ  AO 057  (ID  ECHO-1  HOSTILE)) 

(RPAQQ  AO 056  (PLATFORM  ECHO-1)) 

(RPAQQ  AO 055  (CLASS  DESNA  KAZBEK)) 

(RPAQQ  A0054  (MEDIUM  DESNA  SURFACE)) 

(RPAQQ  A0053  (TYPE  DESNA  OILER)) 

(RPAQQ  AO 052  ( ID- AMPLIFY  DESNA  MIL-AUXIL) ) 

(RPAQQ  AO 051  (ID  DESNA  HOSTILE)) 

(RPAQQ  A0050  (PLATFORM  DESNA)) 

(RPAQQ  A0u49  (CLASS  CONSTELLATION  KITTYHAWK) ) 

(RPAQQ  AO 04 8  (MEDIUM  CONSTELLATION  SURFACE)) 

(RPAQQ  A0047  (TYPE  CONSTELLATION  CARRIER) ) 

(RPAQQ  A0046  ( ID-AMPLIFY  CONSTELLATION  MIL-BATTLE)) 
(RPAQQ  A0045  (ID  CONSTELLATION  FRIEND)) 

(RPAQQ  A0044  (PLATFORM  CONSTELLATION)) 

(RPAQQ  A0 04 3  (CLASS  ADMIRAL!  MAKAROV  KRESTAII) ) 

(RPAQQ  A0042  (MEDIUM  ADMIRAL!  MAKAROV  SURFACE)) 

(RPAQQ  A0041  (TYPE  ADMIRAL!  MAKAROV  CRUISER)) 

(RPAQQ  A0040  (ID-AMPLIFY  ADMIRAL!  MAKAROV  MIL-BATTLE)) 
(RPAQQ  A0 03 9  (ID  ADMIRAL!  MAKAROV  HOSTILE)) 

(RPAQQ  A0038  (PLATFORM  ADMIRAL!  MAKAROV)) 

(RPAQQ  A0037  (CLASS  ADMIRAL!  GOLOVKO  KYNDA) ) 

(RPAQQ  A0036  (MEDIUM  ADMIRAL!  GOLOVKO  SURFACE)) 

(RPAQQ  A0035  (TYPE  ADMIRAL!  GOLOVKO  CRUISER)) 

(RPAQQ  A0034  (ID-AMPLIFY  ADMIRAL!  GOLOVKO  MIL-BATTLE)) 
(RPAQQ  A0033  (ID  ADMIRAL!  GOLOVKO  HOSTILE)) 
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(RPAQQ  A0032  (PLATFORM  ADMIRAL%  GOLOVKO)) 

( RPAQQ  A0031  (CLASS  CONNOLE  KNOX)) 

(RPAQQ  A0030  (TYPE  CONNOLE  FRIGATE)) 

(RPAQQ  AO 02 9  ( ID- AMPLIFY  CONNOLE  MIL-BATTLE)) 

(RPAQQ  AO 02 8  (ID  CONNOLE  FRIEND)) 

(RPAQQ  AO 02 7  (OWNSHIP  CONNOLE)) 

(RPAQQ  A0026  (LOCATION  LANE3  ((55.66  -39.84) 

(57.23  -36.36) 

(58.56  -32.89) 

(59.77  -29.01) 

(61.17  -23.79) 

(62.08  -19.37) 

(62.99  -13.96) 

(63.79  -6.72)))) 

(RPAQQ  A0 02 5  (LOCATION  LANE2  ((56.04  -42.25) 

(58.45  -37.9) 

(60.37  -33.75) 

(61.85  -29.94) 

(63.19  -26.0) 

(64.01  -22.99)))) 

(RPAQQ  A0024  (LOCATION  LANE1  ((68.93  -13.82) 

(68.39  -16.57) 

(66.79  -23.11) 

(66.11  -25.32) 

(65.02  -28.53) 

(64.19  -30.47) 

(63.34  -32.47) 

(62.11  -35.08) 

(60.64  -37.76) 

(59.21  -40.16) 

(58.14  -41.7)))) 

(RPAQQ  A0023  (FROM-PORT  LANE3  ST.JOHNS)) 

(RPAQQ  A0022  (TO- PORT  LANE3  MURMANSK)) 

RPAQQ  A0021  (FROM-PORT  LANE 2  ST.JOHNS)) 

RPAQQ  A0020  (TO-PORT  LANE2  REYKJAVIK)) 

-PA^.  A001 9  (FROM-PORT  LAN El  MURMANSK)) 

•  Ay.  AO 0 1 6  (TO-PORT  LANE1  REYKJAVIK)) 

a. ■ 1  .  AERCHANTLANE  LANE3)) 

*  WERCHANTLANE  LANE2) ) 


L 
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<RPAQQ  A0015  (MERCHANTLANE  LANE1) ) 
(PUTPROPS  A0175  MB  1.0) 

(PUTPROPS  AO 174  MB  1.0) 

(PUTPROPS  A0173  MB  1.0) 

(PUTPROPS  A0172  MB  1.0) 


(PUTPROPS  A0171  MB 

1.0) 

(PUTPROPS  A0170  MB 

1.0) 

(PUTPROPS  AO 16 9  MB 

1.0) 

(PUTPROPS  A0168  MB 

1.0) 

(PUTPROPS  A0167  MB 

1.0) 

(PUTPROPS  AO 166  MB 

1.0) 

(PUTPROPS  AO 16 5  MB 

1.0) 

(PUTPROPS  AO 16 4  MB 

1.0) 

(PUTPROPS  AO 163  MB 

1.0) 

(PUTPROPS  AO 16 2  MB 

1.0) 

(PUTPROPS  A0161  MB 

1.0) 

(PUTPROPS  A0160  MB  J 

L.O) 

(PUTPROPS  AO 159  MB  J 

L.O) 

(PUTPROPS  AO 158  MB  1 

.0) 

(PUTPROPS  A0157  MB  1 

.0) 

(PUTPROPS  A0156  MB  1 

.0) 

(PUTPROPS  A0155  MB  1 

.0) 

(PUTPROPS  A0154  MB  1 

.0) 

(PUTPROPS  AO 153  MB  1, 

.0) 

(PUTPROPS  AO 152  MB  1, 

.0) 

(PUTPROPS  AO 151  MB  1. 

0) 

(PUTPROPS  AO 150  MB  1. 

0) 

(PUTPROPS  A0149  MB  1. 

0) 

(PUTPROPS  A0148  MB  1. 

0) 
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(PUTPROPS  A0147  MB  1.0) 
(PUTPROPS  AO 146  MB  1.0) 
(PUTPROPS  A0145  MB  1.0) 
(PUTPROPS  AO 144  MB  1.0) 
(PUTPROPS  AO 143  MB  1.0) 
(PUTPROPS  A0142  MB  1.0) 
(PUTPROPS  AO 141  MB  1.0) 
(PUTPROPS  A0140  MB  1.0) 
(PUTPROPS  A0139  MB  1.0) 
(PUTPROPS  A0138  MB  1.0) 
(PUTPROPS  A0137  MB  1.0) 
(PUTPROPS  A0136  MB  1.0) 
(PUTPROPS  AO 13 5  MB  1.0) 
(PUTPROPS  A0134  MB  1.0) 
(PUTPROPS  A0133  MB  1.0) 
(PUTPROPS  A0132  MB  1.0) 
(PUTPROPS  A0131  MB  1.0) 
(PUTPROPS  A0130  MB  1.0) 
(PUTPROPS  A0129  MB  1.0) 
(PUTPROPS  A0128  MB  1.0) 
(PUTPROPS  A0127  MB  1.0) 
(PUTPROPS  A0 126  MB  1.0) 
(PUTPROPS  A0125  MB  1.0) 
(PUTPROPS  A0 124  MB  1.0) 
(PUTPROPS  A0123  MB  1.0) 
(PUTPROPS  A0122  MB  1.0) 
(PUTPROPS  A0 121  MB  1.0) 
(PUTPROPS  A0 120  MB  1.0) 
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(PUTPROPS  A0119  MB  1.0) 
(PUTPROPS  AO 11 8  MB  1.0) 
(PUTPROPS  A0117  MB  1.0) 
(PUTPROPS  AO 116  MB  1.0) 
(PUTPROPS  A0115  MB  1.0) 
(PUTPROPS  A0 11 4  MB  1.0) 
(PUTPROPS  A0113  MB  1.0) 
(PUTPROPS  A0112  MB  1.0) 
(PUTPROPS  A0111  MB  1.0) 
(PUTPROPS  A0110  MB  1.0) 
(PUTPROPS  A0109  MB  1.0) 
(PUTPROPS  A0108  MB  1.0) 
(PUTPROPS  A0 107  MB  1.0) 
(PUTPROPS  A0106  MB  1.0) 
(PUTPROPS  A0105  MB  1.0) 
(PUTPROPS  A0 104  MB  1.0) 
(PUTPROPS  A0103  MB  1.0) 
(PUTPROPS  A0102  MB  1.0) 
(PUTPROPS  A0101  MB  1.0) 
(PUTPROPS  A0100  MB  1.0) 
(PUTPROPS  A0 099  MB  1.0) 
(PUTPROPS  A0098  MB  1.0) 
(PUTPROPS  A0 097  MB  1.0) 
(PUTPROPS  A0 096  MB  1.0) 
(PUTPROPS  A0 095  MB  1.0) 
(PUTPROPS  A0 094  MB  1.0) 
(PUTPROPS  AO 093  MB  1.0) 
(PUTPROPS  AO 092  MB  1.0) 
(PUTPROPS  AO 091  MB  1.0/ 


r 

1 
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(PUTPROPS 

AO  090 

MB 

1.0) 

(PUTPROPS 

AO  089 

MB 

1.0) 

(PUTPROPS 

(PUTPROPS 

A0088 

MB 

1.0) 

AO  087 

MB 

1.0) 

(PUTPROPS 

AO  086 

MB 

1.0) 

, 

(PUTPROPS 

A0  085 

MB 

1.0) 

. 

(PUTPROPS 

A0  084 

MB 

1.0) 

(PUTPROPS 

A0  083 

MB 

1.0) 

(PUTPROPS 

A0  082 

MB 

1.0) 

(PUTPROPS 

A0081 

MB 

1.0) 

(PUTPROPS 

A0  080 

MB 

1.0) 

(PUTPROPS 

A0  07  9 

MB 

1.0) 

(PUTPROPS 

A0  07  8 

MB 

1.0) 

(PUTPROPS 

A0077 

MB 

1.0) 

(PUTPROPS 

AO  07  6 

MB 

1.0) 

k  (PUTPROPS 

AO  07  5 

MB 

1.0) 

f  (PUTPROPS 

AO  07  4 

MB 

1.0) 

(PUTPROPS 

AO  07  3 

MB 

1.0) 

(PUTPROPS 

' 

AO  07  2 

MB 

1.0) 

(PUTPROPS 

AO  071 

MB 

1.0) 

(PUTPROPS 

AO  070 

MB 

1.0) 

(PUTPROPS 

AO  06  9 

MB 

1.0) 

(PUTPROPS 

AO  06  8 

MB 

1.0) 

„ 

(PUTPROPS 

A0067 

MB 

1.0) 

:  (PUTPROPS 

A0066 

MB 

1.0) 

.  (PUTPROPS 

AO  06  5 

MB 

1.0) 

f  (PUTPROPS 

AO  06  4 

MB 

1.0) 

1  (PUTPROPS 

AO  06  3 

MB 

1.0) 

* 

J 

1 1  i  JB 
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(PUTPROPS 

AO  06  2 

MB 

1.0) 

(PUTPROPS 

AO  061 

MB 

1.0) 

(PUTPROPS 

A0060 

MB 

1.0) 

(PUTPROPS 

A0059 

MB 

1.0) 

(PUTPROPS 

A0058 

MB 

1.0) 

(PUTPROPS 

A0057 

MB 

1.0) 

(PUTPROPS 

AO  056 

MB 

1.0) 

(PUTPROPS 

AO  055 

MB 

1.0) 

(PUTPROPS 

AO  054 

MB 

1.0) 

(PUTPROPS 

A0  053 

MB 

1.0) 

(PUTPROPS 

A0  052 

MB 

1.0) 

(PUTPROPS 

A0  051 

MB 

1.0) 

(PUTPROPS 

A0050 

MB 

1.0) 

(PUTPROPS 

A0049 

MB 

1.0) 

(PUTPROPS 

A 0048 

MB 

1.0) 

(PUTPROPS 

A0047 

MB 

1.0) 

(PUTPROPS 

A0046 

MB 

1.0) 

(PUTPROPS 

A0045 

MB 

1.0) 

(PUTPROPS 

A0044 

MB 

1.0) 

(PUTPROPS 

A0043 

MB 

1.0) 

(PUTPROPS 

A0042 

MB 

1.0) 

(PUTPROPS 

A0041 

MB 

1.0) 

(PUTPROPS 

A0040 

MB 

1.0) 

(PUTPROPS 

AO  03  9 

MB 

1.0) 

(PUTPROPS 

A0038 

MB 

1.0) 

(PUTPROPS 

A0037 

MB 

1.0) 

(PUTPROPS 

A0036 

MB 

1.0) 

(PUTPROPS 

A0035 

MB 

1.0) 

(PUTPROPS 

A0034 

MB 

1.0) 
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(PUTPROPS 

A0033 

MB 

1.0) 

(PUTPROPS 

A0032 

MB 

1.0) 

(PUTPROPS 

A0031 

MB 

1.0) 

(PUTPROPS 

A0030 

MB 

1.0) 

(PUTPROPS 

A0029 

MB 

1.0) 

(PUTPROPS 

A0028 

MB 

1.0) 

(PUTPROPS 

A0027 

MB 

1.0) 

(PUTPROPS 

AO  026 

MB 

1.0) 

(PUTPROPS 

A0025 

MB 

1.0) 

(PUTPROPS 

A0024 

MB 

1.0) 

(PUTPROPS 

A0023 

MB 

1.0) 

(PUTPROPS 

A0022 

MB 

1.0) 

(PUTPROPS 

A0021 

MB 

1.0) 

(PUTPROPS 

A0020 

MB 

1.0) 

(PUTPROPS 

A0019 

MB 

1.0) 

(PUTPROPS 

A0018 

MB 

1.0) 

(PUTPROPS 

AO  017 

MB 

1.0) 

(PUTPROPS 

A0016 

MB 

1.0) 

(PUTPROPS 

AO  01 5 

MB 

1.0) 

(PUTPROPS 

AO  17  5 

MD 

0.0) 

(PUTPROPS 

A0174 

MD 

0.0) 

(PUTPROPS 

A0173 

MD 

0.0) 

(PUTPROPS 

AO  17  2 

MD 

0.0) 

(PUTPROPS 

AO  171 

MD 

0.0) 

(PUTPROPS 

A0170 

MD 

0.0) 

(PUTPROPS 

AO  16  9 

MD 

0.0) 

(PUTPROPS 

AO  16  8 

MD 

0.0) 

(PUTPROPS 

A0167 

MD 

0.0) 
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(PUTPROPS 

A0166 

MD 

0.0) 

(PUTPROPS 

AO  16  5 

MD 

0.0) 

(PUTPROPS 

A0164 

MD 

0.0) 

(PUTPROPS 

A0163 

MD 

0.0) 

(PUTPROPS 

A0162 

MD 

0.0) 

(PUTPROPS 

A0161 

MD 

0.0) 

(PUTPROPS 

AO  160 

MD 

0.0) 

(PUTPROPS 

A0159 

MD 

0.0) 

(PUTPROPS 

A0158 

MD 

0.0) 

(PUTPROPS 

A0157 

MD 

0.0) 

(PUTPROPS 

AO  156 

MD 

0.0) 

(PUTPROPS 

A0155 

MD 

0.0) 

(PUTPROPS 

A0154 

MD 

0.0) 

(PUTPROPS 

AO  153 

MD 

0.0) 

(PUTPROPS 

AO  152 

MD 

0.0) 

(PUTPROPS 

AO  151 

MD 

0.0) 

(PUTPROPS 

A0150 

MD 

0.0) 

(PUTPROPS 

A0149 

MD 

0.0) 

(PUTPROPS 

A0148 

MD 

0.0) 

(PUTPROPS 

A0147 

MD 

0.0) 

(PUTPROPS 

AO  146 

MD 

0.0) 

(PUTPROPS 

A0145 

MD 

0.0) 

(PUTPROPS 

A0144 

MD 

0.0) 

(PUTPROPS 

AO  143 

MD 

0.0) 

(PUTPROPS 

AO  142 

MD 

0.0) 

(PUTPROPS 

AO  141 

MD 

0.0) 

(PUTPROPS 

AO  140 

MD 

0.0) 

(PUTPROPS 

A0139 

MD 

0.0) 

(PUTPROPS  AO 13 8  MD  0.0) 
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(PUTPROPS 

A0137 

MD 

0.0) 

(PUTPROPS 

A0136 

MD 

0.0) 

(PUTPROPS 

AO  13  5 

MD 

0.0) 

(PUTPROPS 

A0134 

MD 

0.0) 

(PUTPROPS 

A0133 

MD 

0.0) 

(PUTPROPS 

A0132 

MD 

0.0) 

(PUTPROPS 

A0131 

MD 

0.0) 

(PUTPROPS 

A0130 

MD 

0.0) 

(PUTPROPS 

A0129 

MD 

0.0) 

(PUTPROPS 

A0128 

MD 

0.0) 

(PUTPROPS 

A0127 

MD 

0.0) 

(PUTPROPS 

A0126 

MD 

0.0) 

(PUTPROPS 

A0125 

MD 

0.0) 

(PUTPROPS 

A0124 

MD 

0.0) 

(PUTPROPS 

AO  123 

MD 

0.0) 

(PUTPROPS 

A0122 

MD 

0.0) 

(PUTPROPS 

AO  121 

MD 

0.0) 

(PUTPROPS 

A0120 

MD 

0.0) 

(PUTPROPS 

A0119 

MD 

0.0) 

(PUTPROPS 

AO  11 8 

MD 

0.0) 

(PUTPROPS 

A0117 

MD 

0.0) 

(PUTPROPS 

A0116 

MD 

0.0) 

(PUTPROPS 

A0115 

MD 

0.0) 

(PUTPROPS 

AO  11 4 

MD 

0.0) 

(PUTPROPS 

A0113 

MD 

0.0) 

(PUTPROPS 

AO  112 

MD 

0.0) 

(PUTPROPS 

A0111 

MD 

0.0) 

(PUTPROPS  A0110  HD  0.0) 
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(PUTPROPS 

A0109 

MD 

0.0) 

(PUTPROPS 

A0108 

MD 

0.0) 

(PUTPROPS 

A0107 

MD 

0.0) 

(PUTPROPS 

AO  106 

MD 

0.0) 

(PUTPROPS 

A0105 

MD 

0.0) 

(PUTPROPS 

A0104 

MD 

0.0) 

(PUTPROPS 

AO  103 

MD 

0.0) 

(PUTPROPS 

A0102 

MD 

0.0) 

(PUTPROPS 

A0 101 

MD 

0.0) 

(PUTPROPS 

A0100 

MD 

0.0) 

(PUTPROPS 

A0  099 

MD 

0.0) 

(PUTPROPS 

A0098 

MD 

0.0) 

(PUTPROPS 

AO  097 

MD 

0.0) 

(PUTPROPS 

AO  096 

MD 

0.0) 

(PUTPROPS 

A0  095 

MD 

0.0) 

(PUTPROPS 

A0C94 

MD 

0.0) 

(PUTPROPS 

A0093 

MD 

0.0) 

(PUTPROPS 

A0  092 

MD 

0.0) 

(PUTPROPS 

A0091 

MD 

0.0) 

(PUTPROPS 

A0090 

MD 

0.0) 

(PUTPROPS 

A0089 

MD 

0.0) 

(PUTPROPS 

A0088 

MD 

0.0) 

(PUTPROPS 

A0  087 

MD 

0.0) 

(PUTPROPS 

A0  086 

MD 

0.0) 

(PUTPROPS 

A0  085 

MD 

0.0) 

(PUTPROPS 

AO  084 

MD 

0.0) 

(PUTPROPS 

AO  083 

MD 

0.0) 

(PUTPROPS 

AO  082 

MD 

0.0) 

(PUTPROPS  AO 081  MD  0.0) 
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(PUTPROPS 

AO  080 

MD 

0.0) 

(PUTPROPS 

A0079 

MD 

0.0) 

(PUTPROPS 

A0078 

MD 

0.0) 

(PUTPROPS 

A0  07  7 

MD 

0.0) 

(PUTPROPS 

A0076 

MD 

0.0) 

(PUTPROPS 

A0  07  5 

MD 

0.0) 

(PUTPROPS 

A0  07  4 

MD 

0.0) 

(PUTPROPS 

A0073 

MD 

0.0) 

(PUTPROPS 

A0072 

MD 

0.0) 

(PUTPROPS 

A0071 

MD 

0.0) 

(PUTPROPS 

A0070 

MD 

0.0) 

(PUTPROPS 

A0069 

MD 

0.0) 

(PUTPROPS 

A0068 

MD 

0.0) 

(PUTPROPS 

A0067 

MD 

0.0) 

(PUTPROPS 

A0066 

MD 

0.0) 

(PUTPROPS 

A0  06  5 

MD 

0.0) 

(PUTPROPS 

A0  06  4 

MD 

0.0) 

(PUTPROPS 

A0  06  3 

MD 

0.0) 

(PUTPROPS 

A0  06  2 

MD 

0.0) 

(PUTPROPS 

AO  061 

MD 

0.0) 

(PUTPROPS 

AO  060 

MD 

0.0) 

(PUTPROPS 

A0059 

MD 

0.0) 

(PUTPROPS 

A0058 

MD 

0.0) 

(PUTPROPS 

A0057 

MD 

0.0) 

(PUTPROPS 

AO  056 

MD 

0.0) 

(PUTPROPS 

A0055 

MD 

0.0) 

(PUTPROPS 

AO  054 

MD 

0.0) 

(PUTPROPS  AO 053  MD  0.0) 
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(PUTPROPS 

AO  052 

MD 

0.0) 

( PUTPROPS 

AO  051 

MD 

0.0) 

(PUTPROPS 

A0050 

MD 

0.0) 

(PUTPROPS 

A0049 

MD 

0.0) 

(PUTPROPS 

A0048 

MD 

0.0) 

(PUTPROPS 

A0047 

MD 

0.0) 

(PUTPROPS 

A0046 

MD 

0.0) 

(PUTPROPS 

A0045 

MD 

0.0) 

(PUTPROPS 

A0044 

MD 

0.0) 

(PUTPROPS 

A0043 

MD 

0.0) 

(PUTPROPS 

A0G42 

MD 

0.0) 

(PUTPROPS 

A0041 

MD 

0.0) 

(PUTPROPS 

A0040 

MD 

0.0) 

(PUTPROPS 

AO  03  9 

MD 

0.0) 

(PUTPROPS 

A003  8 

MD 

0.0) 

(PUTPROPS 

AO  03  7 

MD 

0.0) 

(PUTPROPS 

A0036 

MD 

0.0) 

(PUTPROPS 

A0035 

MD 

0.0) 

(PUTPROPS 

AO  03  4 

MD 

0.0) 

(PUTPROPS 

A0033 

MD 

0.0) 

(PUTPROPS 

A0032 

MD 

0.0) 

(PUTPROPS 

A0031 

MD 

0.0) 

(PUTPROPS 

A0030 

MD 

0.0) 

(PUTPROPS 

A0  02  9 

MD 

0.0) 

(PUTPROPS 

A0028 

MD 

0.0) 

(PUTPROPS 

A0027 

MD 

0.0) 

(PUTPROPS 

A0026 

MD 

0.0) 

(PUTPROPS 

A0  02  5 

MD 

0.0) 

(PUTPROPS 

A0024 

MD 

0.0) 

uut^r  rx 
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(PUTPROPS  A0023  MD  0.0) 

(PUTPROPS  A0022  MD  0.0) 

(PUTPROPS  A0021  MD  0.0) 

(PUTPROPS  A0020  MD  0.0) 

(PUTPROPS  A0019  MD  0.0) 

(PUTPROPS  A0018  MD  0.0) 

(PUTPROPS  A0 017  MD  0.0) 

(PUTPROPS  A0 01 6  MD  0.0) 

(PUTPROPS  A0015  MD  0.0) 

(CREATH  MEMSIZE) 

[MAPC  ASSERTIONS  (FUNCTION  (LAMBDA  (Q) 

(SERT  (EVAL  Q) 

QJ 

(PRIN1  "Memory  Reinitialized") 

(TERPRI) 

(DECLARE:  DONTCOPY 
(FILEMAP  (NIL))) 

STOP 
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(FILECREATED  "23-Aug-7S  17:56:55"  <RBECHTAL>MSGMTR. .27  16895 


changes  to:  WEATHERMSG 

previous  date:  "  6-Aug-79  09:36:54"  <RBECHTAL>MSGMTR. .26) 


(PRETTYCOMPRINT  MSGMTRCOMS) 

( RPAQQ  MSGMTRCOMS  ((VARS  *  MSGMTRVARS) 

(FNS  *  MSGMTRFNS) ) ) 

(RPAQQ  MSGMTRVARS  (DSPLAYFLG  MSGFILE  OWNSHIP  SENSORANGE  CURTIME) ) 

(RPAQQ  DSPLAYFLG  NIL) 

(RPAQQ  MSGFILE  SCENE. ICE) 

(RPAQQ  OWNSHIP  CONNOLE) 

(RPAQQ  SENSORANGE  25) 

(RPAQQ  CURTIME  0) 

(RPAQQ  MSGMTRFNS  (BEYONDINTEREST  DESCRIBEMSG  DISPCHECK  DISPLAY  DISPLOB 

DISPMARK  EWMSG  GREATESTPROB  IDENT 
INTERPOLABLE  MEDIUM  MELD  MIDP  MSGMTR 
NEWSYM  ONNMSG  OWNP OS  SENSORMSG 
TWO- PLACE  WEATHERMSG)) 

(DEFINEQ 

(1281 


(BEYONDINTEREST 
[LAMBDA  (TXT) 

NIL)  ) 


(*  edited: 
"31-JU1-79  09:21") 


[1291 


(DESCRIBEMSG 

[LAMBDA  (TXT)  (*  edited: 

"  6-Aug-79  08:53") 

(*  DESCRIBEMSG  prints  the  information  contained  in  a 
message  in  a  relatively  nice  format  for  the  user. 

The  function  itself  is  fairly  simplef  if  tedious. 

After  determining  the  type  of  message,  the 
information  is  printed.  Messages  concerning  the  home 
ship  are  ignored.  After  printing,  if  display  is 
enabled,  a  picture  containing  the  new  location  is 
drawn. ) 


(PROG  ( (WKNM  (CAR  TXT)) 

(SOURCE  (CADR  TXT)) 


AD-A084  053 


SDC  INTEGRATED  SERVICES  INC  SAN  DIEGO  CA  F/G  9/2 

STAMMER2  PRODUCTION  SYSTEM  FOR  TACTICAL  SITUATION  ASSESSMENT.  V— ETC<U> 
OCT  79  D  C  MCCALL*  P  H  MORRIS*  0  F  KIBLER  N00123-76-C-0172 

N0SC-TD-296-V0L-2  NL 


liNCLASSIFIFO 
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(TIME  (CAR  (LAST  TXT))) 

POS) 

(SETQ  CORTIME  TIME) 

(COND 

((EQ  WKNM  OWNSHIP) 

(RETURN))) 

[COND 

((EQ  (CADR  TXT) 

(QUOTE  WEATHER)) 

(TERPRI) 

(SPACES  5) 

(PRIN1  "Weather  report.*) 

(TERPRI) 

(SPACES  5) 

(PRINI  "Storm  centered  at  ") 

(PRIN1  (CENTROID  (CADDR  TXT))) 

(TERPRI) 

(COND 

(DSPLAYFLG  (TERPRI) 

(SPACES  10) 

(PRINI  "Display  follows") 

(TERPRI) 

(WAITER) 

(DSPCMD  "PTR  PLr  ST") ) ) 

(RETURN) ) 

[ (NUMBERP  (CADDDR  TXT) ) 

(SETQ  POS  (LIST  (CADDR  TXT) 

(CADDDR  TXT))) 

(COND 

((OR  (EQ  SOURCE  (QUOTE  RADAR)) 

(EQ  SOURCE  (QUOTE  SONAR))) 

(TERPRI) 

(SPACES  5) 

(PRINI  SOURCE) 

(PRINI  ■  contact  at  ") 

(PRINI  POS) 

(PRINI  "  Time:  ") 

(PRINI  TIME)) 

(T  (TERPRI) 

(SPACES  5) 

(PRINI  "Message  received  from  external  source.") 
(TERPRI) 

(SPACES  5) 

(PRINI  "Something  detected  at  ") 

(PRINI  POS) 

(PRINI  "  Time:  ") 

(PRINI  TIME] 

(T  (SETQ  POS  (CADDR  TXT)) 

(COND 

((EQ  SOURCE  (QUOTE  EXTERNAL)) 

(TERPRI) 

(SPACES  5) 

(PRINI 

"Message  from  external  source.  Heard  something  at  bearing  ”) 
(PRINI  POS) 

[SETQ  POS  (LIST  (CAR  (CDDDDR  TXT)) 

(CADR  (CDDDDR  TXT] 
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(TERPRI) 

(SPACES  5) 

(PRIN1  "Detector  located  at  ") 

(PRINl  POS) 

(PR INI  "  Time:  ") 

(PRIN1  TINE)) 

(T  (TERPRI) 

(SPACES  5) 

(PRIN1  "Passive  detection.  Heard  ") 
(PR INI  (CADDDR  TXT)) 

(PRIN1  "  at  bearing  ") 

(PRIN1  POS) 

(PRIN1  "  Time:  ") 

(PRIN1  TIME] 

(TERPRI) 

(SPACES  5) 

(PRINl  "Associated  with  track  ") 

(PR INI  WKNM) 

(TERPRI) 

(TERPRI) 

(COND 

(DSPLAYFLG  (PRINl  "  Display  follows.") 

(TERPRI) 

(WAITER) 

(DSPCMD  "PTR  PL")) 


[1301 


(DISPCHECK 

[LAMBDA  (NAME)  (*  edited: 

"  6- Aug-7 9  08:55") 

(*  This  function  checks  the  property  list  of  a 
platform  name  to  determine  if  the  platform  has 
already  been  placed  in  the  display. 

If  not,  a  DSPADDTRH  needs  to  be  performed.) 


(GETPROP  NAME  (QUOTE  INDISPLAY]) 


[131] 


(DISPLAY 

[LAMBDA  (PLATNAKE  LAT  LON  TIME)  (*  edited: 

"  6-Aug-79  08:56") 

(*  DISPLAY  does  the  necessary  stuff  to  get  a  new 
platform  sighting  added  to  the  display  file. 

If  the  platform  is  new  to  the  display,  it  is  added 
to  the  display  file,  otherwise,  only  the  new 
sighting  is  added.) 


(COND 

(DSPLAYFLG  (COND 

((DISPCHECK  PLATNAME) 

(DSPADDINC  PLATNAME  LAT  LON  (FLOAT  TIME))) 
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(T  (DSPADDTRH  PLATNAME  (QUOTE  PL) 

(MELD  (I DENT  PLATNAME) 

(MEDIUM  PLATNAME))) 
(DISPMARK  PLATNAME) 

(DSPADDINC  PLATNAME  LAT  LON  (FLOAT  TIME)) 


[132) 


(DISPLOB 

[LAMBDA  (PNAME  SPOS  DPOS  TIME)  (*  edited: 

"  6-Aug-79  08:59") 

(*  DISPLOB  displays  lines  of  bearing 
(such  as  those  obtained  by  EW  sightings)  by  adding 
the  midpoint  of  a  line  drawn  from  the  detecting 
craft  location  to  a  point  maxsensorange  miles 
(50)  along  the  given  bearing  to  the  display.) 


(PROG  (TEMPI  TEMP2) 

(COND 

(DSPLAYFLG  (SETQ  TEMPI  (MIDP  (CAR  SPOS) 

(CAR  DPOS))) 

(SETQ  TEMP2  (MIDP  (CADR  SPOS) 

(CADR  DPOS))) 

(DISPLAY  PNAME  TEMPI  TEMP2  TIME)) 

[1331 

(DISPMARK 

[LAMBDA  (NAME)  (*  edited: 

"  6-Aug-79  09:00")  I 

(*  DISPMARK  places  a  marker  on  the  property  list  of  I 

platforms  that  have  been  entered  into  the  display  I 

file.)  I 


(PUTPROP  NAME  (QUOTE  INDISPLAY) 

Tl) 

[1341 

(EWMSG 

[LAMBDA  (TXT  EXTFLG)  (*  edited: 

"  6-Aug-79  09:04")  I 

(*  EWMSG  adds  information  contained  in  EW  messages  I 

to  the  network.  The  information  includes  position  I 

information  (a  line  from  the  detecting  platform  I 

along  the  LOB  for  50  miles) ,  the  time  of  the  I 

detection,  and,  if  the  detection  was  made  by  the  I 

homeship,  the  emitter  detected.)  I 


(PROG  ((SNODE  (NEWSYM  (QUOTE  SIGHTING))) 
(WKNM  (CAR  TXT)) 
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(SOURCE  (CADR  TXT)) 

(BEAR  (CADDR  TXT)) 

(EMIT  (CADDDR  TXT)) 

TEMPLACE1  TEMPLACE2  TIME) 

(CASSERT  (LIST  (QUOTE  SOURCE) 

SNODE  SOURCE) 

1.0) 

(COND 

( EXTPLG  (SETQ  TIME  (CADDDR  (CDDDR  TXT))) 

( CASSERT 

[LIST  (QUOTE  POSITION) 

SNODE 

(LIST  ISETQ  TEMPLACEl 

(LIST  (CADDR  (CDDR  TXT)) 

(CADDR  (CDDDR  TXT] 

(SETQ  TEMPLACE2 

(GETPOINT  TEMPLACEl  BEAR  SENSORANGE] 

1.0) 

(CASSERT  (LIST  (QUOTE  TOS) 

SNODE  TIME) 

1.0)) 

(T  (SETQ  TIME  (CADR  (CDDDR  TXT))) 

(CASSERT  (LIST  (QUOTE  TOS) 

SNODE  TIME) 

1.0) 

(CASSERT  (LIST  (QUOTE  EMITTER) 

SNODE  EMIT) 


1.0) 

(CASSERT  [LIST  (QUOTE  POSITION) 

SNODE 

(LIST  (SETQ  TEMPLACEl  (OWNPOS  TIME)) 
(SETQ  TEMPLACE2 

(GETPOINT  TEMPLACEl  BEAR 
SENSORANGE] 

1.0))) 

(CASSERT  (LIST  (QUOTE  SIGHTING) 

WKNH  SNODE) 

1.0) 

(DISPLOB  WKNM  TEMPLACEl  TEMPLACE2  TIKE)) 


[135] 


(GREATESTPROB 

[LAMBDA  (POSLIST)  (*  edited: 

"  6-Aug-79  09:07") 

(*  GREATESTPROB  takes  a  list  of  answers  of  the  form 
that  RETRIEVER  returns,  and  examines  them,  returning 
the  element  whose  confidence  is  highest. 

If  no  element  has  positive  confidence,  or  if  more 

than  one  element  is  equally  likely 

(at  greatest  confidence),  GREATESTPROB  returns  NIL.) 


(PROG  (ANS  (ANSCON  0.0)) 

[MAPC  POSLIST  (FUNCTION  (LAMBDA  (A) 
(COND 


f  .  -  .-w 
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((GREATERP  (GETCON  (CAR  A)) 
ANSCON) 

(SETQ  ANSCON  (GETCON  (CAR  A))) 
(SETQ  ANS  A)) 

( (EQP  ANSCON  (GETCON  (CAR  A))) 
(SETQ  ANS  NIL] 

(RETURN  ANS]) 


1136] 


(IDENT 

[LAMBDA  (NAME)  (*  edited: 

"  6-Aug-79  09:09") 

(*  Used  in  display  initialization  of  platforms,  this 
attempts  to  determine  whether  the  platform  is 
FRIEND,  HOSTILE,  or  UNKNOWN,  and  returns  the 
apprpriate.  Default  is  UNKNOWN.) 


(PROG  (POSIB  ANS) 

[SETQ  POSIB  (RETRIEVER  (LIST  (QUOTE  ID) 

NAME 

(QUOTE  *WHAID] 

(SETQ  ANS  (GREATESTPROB  POSIB)) 

(COND 

(ANS  (RETURN  (CDDR  ANS))) 

(T  (RETURN  (QUOTE  UNKNOWN]) 


[1371 


(INTERPOLABLE 
[LAMBDA  (TXT) 

NIL]) 


(*  edited: 
"31-Jul-79  09:21") 


[1381 


(MEDIUM 

[LAMBDA  (NAME)  (*  edited: 

"  6-Aug-79  09:11") 

(*  Determines  the  medium  of  a  platform. 

Default  is  SURFACE  (as  opposed  to  SUB  or  AIR).) 


(PROG  (TEMPI  RETURNER) 

[SETQ  TEMPI  (RETRIEVER  (LIST  (QUOTE  MEDIUM) 

NAME 

(QUOTE  **WHAMED] 

(SETQ  RETURNER  (GREATESTPROB  TEMPI)) 

(COND 

(RETURNER  (RETURN  (CDDR  RETURNER))) 

(T  (RETURN  (QUOTE  SURFACE!) 
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(MELD 

[LAMBDA 


(PROG 


(MIDP 

[LAMBDA 


(PROG 


(MSGMTR 

[LAMBDA 


(ID  MED)  (*  edited: 

-  6 -Aug-7 9  09:12") 

(*  Creates  a  DSPLA  type  to  be  used  for  platforms. 

The  type  controls  the  symbol  used  in  the  display  for 
a  platform.) 


(A  B) 

( SELECTQ  ID 

(UNKNOWN  (SETQ  A  (QUOTE  U) ) ) 
(FRIEND  (SETQ  A  (QUOTE  F) ) ) 
(HOSTILE  (SETQ  A  (QUOTE  H) ) ) 
(SETQ  A  (QUOTE  U) ) ) 

(SELECTQ  MED 

(AIR  (SETQ  B  (QUOTE  A))) 
(SURFACE  (SETQ  B  (QUOTE  S)  ) ) 
(SUB  (SETQ  B  (QUOTE  U) ) ) 
(SETQ  B  (QUOTE  S)  ) ) 

(RETURN  (PACK  (LIST  A  Bi) 


[140] 


(PI  P2)  (*  edited: 

"  6-Aug-79  09:15") 

(*  Returns  the  "average"  of  two  latitudes  or 
longitudes.  The  180  degree  check  is  to  insure  that 
the  shortest  distance  is  taken  when  changing  sign/ 
especially  for  longitude.) 


(TEMP2) 

(SETQ  TEMP2  (FDIFFERENCE  PI  P2)) 

(COND 

KGREATERP  (ABS  TEMP2 ) 

180.0) 

(RETURN  (MINUS  (TWO- PLACE  (FQUOTIENT  TEMP2  2.01 
(T  (RETURN  (TWO-PLACE  (FQUOTIENT  (FPLUS  PI  P2) 

2.0J) 


[1411 


NIL  (*  edited: 

"  6-Aug-79  09:19"> 

(*  MSGMTR  reads  a  message  (LISP  S-expression)  from 
the  designated  message  filef  freezes  deduction/ 
passes  the  message  to  the  appropriate  handler/  then 
unfreezes  the  deductions.  Returns  IGNORE  in  those 
cases  where  the  message  should  have  no  effect  on 
output/  returns  NIL  if  there  are  no  more  messages/ 
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and  returns  T  otherwise.  Messages  about  the  home 
ship  are  ignored  for  printout. 

Messages  out  of  range,  or  predictable  from  existing 
information  are  ignored.) 


(PROG  (OLDIN  MSG) 

(SETQ  OLDIN  (INPUT)) 

(INFILE  MSGFILE) 

(SETQ  MSG  (READ))  . 

(INFILE  OLDIN) 

(FREEZE) 

[COND 

((EQ  MSG  (QUOTE  STOP)) 

(CLOSEF?  MSGFILE) 

(UNFREEZE) 

(RETURN)  ) 

((EQ  (CAR  MSG) 

OWNSHIP) 

(OWNMSG  MSG) 

(UNFREEZE) 

(RETURN  (QUOTE  IGNORE))) 

( (BEYONDINTEREST  MSG) 

(DESCRIBEMSG  MSG) 

(PRINl  "Beyond  area  of  interest.  Ignored.") 

(TERPRI) 

(UNFREEZE) 

(RETURN  (QUOTE  IGNORE))) 

( ( INTERPOLABLE  MSG) 

(DESCRIBEMSG  MSG) 

(PRINl  "Predictable  from  existing  information.  Ignored.") 
(TERPRI) 

(UNFREEZE) 

(RETURN  (QUOTE  IGNORE))) 

((EQ  (CADR  MSG) 

(QUOTE  WEATHER)) 

(WEATHERMSG  MSG)) 

((NUMBERP  (CADDDR  MSG)) 

(SENSORMSG  MSG)) 

(T  (COND 

((EQ  (CADR  MSG) 

(QUOTE  EW)) 

(EWMSG  MSG)) 

(T  (EWMSG  MSG  T] 

(UNFREEZE) 

(DESCRIBEMSG  MSG) 

(RETURN  T]) 


I 


I 


I 


I 


[1421 


(NEWSYM 

(LAMBDA  (NAME) 


(*  edited: 

"  6-Aug-79  09:21") 


(*  NEWSYM  is  a  method  of  generating  custom  atoms. 
It  acts  like  GENSYM,  only  maintains  a  separate 
counter  for  each  atom,  permits  atoms  of  arbitrary 
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length,  and  has  no  leading  zeroes  in  the  numeric 
part.  It  is  also  less  efficient,  both  in  time  and 
space . ) 


ICOND 

t (GETPROP  NAME  (QUOTE  COUNTER)) 

(PUTPROP  NAME  (QUOTE  COUNTER) 

(ADD1  (GETPROP  NAME  (QUOTE  COUNTER] 

(T  (PUTPROP  NAME  (QUOTE  COUNTER) 

1) 

(SETQ  SYMBOLS  (CONS  NAME  SYMBOLS] 

(PACK  (APPEND  (UNPACK  NAME) 

(UNPACK  (GETPROP  NAME  (QUOTE  COUNTER]) 

[143] 

(OWNMSG 

[LAMBDA  (TXT)  (*  edited: 

"  6-Aug-79  09:23")  I 

I 

(*  OWNMSG  updates  the  location  of  the  home  ship  in  I 

the  data  base.  Time  and  location  are  added.)  I 


(PROG  [(SNODE  (NEWSYM  (QUOTE  SIGHTING] 

(CASSERT  (LIST  (QUOTE  TOS) 

SNODE 

(CADDDR  TXT)) 

1.0) 

(CASSERT  (LIST  (QUOTE  POSITION) 

SNODE 

(LIST  (LIST  (CADR  TXT) 

(CADDR  TXT] 

1.0) 

(CASSERT  (LIST  (QUOTE  SIGHTING) 

OWNSHIP  SNODE) 

1.0) 

(DISPLAY  OWNSHIP  (CADR  TXT) 

(CADDR  TXT) 

(CADDDR  TXT]) 

[1441 

(OWNPOS 

[LAMBDA  (TIME)  (*  edited: 

"  6-Aug-79  09:23")  I 
(*  OWNPOS  returns  the  I 
location  of  the  home  I 
ship  at  a  given  time)  I 

(CAR  (PLATPOS  OWNSHIP  TIME]) 

[1451 

(SENSORMSG 

[LAMBDA  (TXT)  (*  edited: 

"  6-Aug-79  09:25")  I 
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(*  SENSORMSG  adds  information  from  sonar  and  radar 
sightings  to  the  data  base.  Sonar  and  radar  messages 
include  time  and  location  information. 

The  source  of  the  message  is  also  added. 

If  there  is  an  indication  of  video 

(radar)  or  return  (sonar)  strength,  this  is  also 

added. ) 


(PROG  ( ( SNODE  (NEWSYM  (QUOTE  SIGHTING))) 
(WKNM  (CAR  TXT)) 

(SOURCE  (CADR  TXT)) 

(LAT  (CADDR  TXT)) 

(STR  (CAR  (CDDDDR  TXT))) 

(LON  (CADDDR  TXT)) 

(TIME  (CAR  (LAST  TXT] 

(CASSERT  (LIST  (QUOTE  POSITION) 

SNODE 

(LIST  (LIST  LAT  LON))) 

1.0) 

(CASSERT  (LIST  (QUOTE  SOURCE) 

SNODE  SOURCE) 

1.0) 

(CASSERT  (LIST  (QUOTE  TOS) 

SNODE  TIME) 

1.0) 

(COND 

((NOT  (EQUAL  STR  TIME)) 

(CASSERT  (LIST  (QUOTE  STRENGTH) 
SNODE  STR) 

1.0))) 

(CASSERT  (LIST  (QUOTE  SIGHTING) 

WKNM  SNODE) 

1.0) 

(DISPLAY  WKNM  LAT  LON  TIME]) 


[1461 


(TWO- PLACE 
[LAMBDA  (X) 


(*  edited: 

"  6-Aug-79  09:26") 


(*  TWO-PLACE  takes  a  number  as  argument,  and  returns 
that  number  rounded  to  two  decimal  places.) 


(FQUOTIENT  (FIX  (FPLUS  .5  (FTIMES  X  100.0))) 

100.01) 


[1471 


(WEATHERMSG 
[LAMBDA  (TXT) 


(*  edited: 
"23-Aug-79  17:56") 


(*  WEATHERMSG  adds  the  information  in  a  weather 
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report  to  memory.  The  information  includes  the 
polygon  that  dafines  the  location  of  the  storm  and 
the  time  that  the  storm  was  sighted. 

If  appropriate^  the  location  of  the  storm  is  added 
to  the  display.) 


(PROG  ((SNAME  (CAR  TXT)) 

(LOC  (CADDR  TXT)) 

(TM  (CADDDR  TXT))) 

(CASSERT  (LIST  (QUOTE  LOCATION) 

SNAME  LOC) 

1.0) 

(CASSERT  (LIST  (QUOTE  STORM) 

SNAME) 

1.0) 

(COND  I 

(DSPLAYFLG  (DSPADDTRH  SNAME  (QUOTE  ST)  I 

(QUOTE  XX))  I 

(MAPC  LOC  (FUNCTION  (LAMBDA  (STVER)  I 

(DSPADDINC  SNAME  (CAR  STVER)  I 

(CADR  STVER)  I 

(FLOAT  TM]) 

) 

(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (688  16871  (BEYONDINTEREST  700  .  813)  (DESCRIBEMSG  817  . 
3489)  (DISPCHECK  3493  .  3926)  (DISPLAY  3930  .  4671)  (DISPLOB  4675  .  5350 
)  (DISPMARK  5354  .  5720)  (EWMSG  5724  .  7356)  (GREATESTPROB  7360  .  8173) 
(IDENT  8177  .  8815)  (INTERPOLABLE  8819  .  8930)  (MEDIUM  8934  .  9480)  ( 
MELD  9484  .  10157)  (MIDP  10161  .  10805)  (MSGMTR  10809  .  12682)  (NEWSYM 
12686  .  13472)  (OWNMSG  13476  .  14150)  (OWNPOS  14154  .  14426)  (SENSORMSG 
14430  .  15635)  (TWO-PLACE  15639  .  15994)  (WEATHERMSG  15998  .  16868))))) 
STOP 
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changes  to:  NEWEXPVARS 

previous  date:  "28-Aug-79  11:35:20"  <DKIBLER>NEWEXP.LSP.33) 


(PRETTYCOMPRINT  NEWEXPCOMS) 

(RPAQQ  NEWEXPCOMS  [(VARS  *  NEWEXPVARS) 

(IFPROP  PRINFORMS  *  RELATIONS) 

( IFPROP  QHPRODS  *  STATES) 

(FNS  *  NEWEXPFNS) 

(P  (LOAD  (QUOTE  QH.COM]) 

(RPAQQ  NEWEXPVARS  I (ASSERTION  NIL) 

RELATIONS 
(RULE  NIL) 
carriagereturn 

(SMALLNUMB  (QUOTE  (123456789))) 

STATES  EXPLAINFLAG 

(DULLREL  (QUOTE  (NOT-FIRST  NOT-LAST  CONTACT  SIGHTING  I 

INSIDE-A-MERCHANTLANE  LESS-THAN  I 

GREATER-THAN  PLATFORM  SAME-AS  I 

FIRST-SIGHTING  LAST-SIGHTING] ) 


(RPAQ  ASSERTION  NIL) 

(RPAQQ  RELATIONS  (CLASS  OWNSHIP  PLATFORM  CONTACT  SIGHTING  SOURCE  TOS 

POSITION  TYPE  EMITTER  DETECTION  FIRST-SIGHTING 
RADAR-MODE  RANGE  LESS-THAN  STRENGTH  MODE 
GREATER-THAN  SPEED  LAND-DIST 
REACHABLE- BY- A-COMBATANT  MEDIUM  INSIDE 
INSIDE-A-MERCHANTLANE  MERCHANTLANE  IN-LANE 
SUCCESSOR  COURSE  ROUGHLY-THE-SAME-COURSE-AS 
ROUGHLY-THE-SAME-SPEED-AS  ID  ID-AMPLIFY 
LOCATION  TO-PORT  FROM-PORT  SAME-AS  PATROL 
POSSIBLE-REPORT  CROSSPATHS  GRAZE  WENT-BEFORE 
WENT-AFTER  BLOCKED-FROM  DISSIMILAR  SWR 
SIMPLY-WITHIN-REACH  WITHIN-REACH  NOT-FIRST 
NOT-LAST  ALIAS  COURSEFROM  SPEEDFROM) ) 


(RPAQ  RULE  NIL) 

(RPAQQ  carriagereturn  % 

) 

(RPAQQ  SMALLNUMB  (123456789)) 

(RPAQQ  STATES  (<EXPLTREE>  <PLATIS>  <VALIS>  <ATTIS>  <TYPIS>  <IDIS> 
<IDAMPIS>  <WHATFORM>  <WHOSE2FORM>  <WHOSEFORM>  <TELLABT> 
<WHEREFORM>  <WHEREITEM>  <WHAT2FORM>  <TYPE2>  <ID2>  <IDAMP2> 
<OCCURNUM>  <OTHER2>) ) 


(RPAQQ  EXPLAINFLAG  NIL) 
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(RPAQQ  DULLREL  (NOT-FIRST  NOT-LAST  CONTACT  SIGHTING  I 

INSIDE-A-MERCHANTLANE  LESS-THAN  GREATER-THAN  I 
PLATFORM  SAME-AS  FIRST-SIGHTING  LAST-SIGHTING) 

) 

(RPAQQ  RELATIONS  (CLASS  OWNSHIP  PLATFORM  CONTACT  SIGHTING  SOURCE  TOS 

POSITION  TYPE  EMITTER  DETECTION  FIRST-SIGHTING 
RADAR-MODE  RANGE  LESS-THAN  STRENGTH  MODE 
GREATER-THAN  SPEED  LAND-DIST 
REACH ABLE- BY- A- COMBATANT  MEDIUM  INSIDE 
INSIDE-A-MERCHANTLANE  MERCHANTLANE  IN-LANE 
SUCCESSOR  COURSE  ROUGHLY-THE-SAME-COURSE-AS 
ROUGHLY-THE-SAME-SPEED-AS  ID  ID-AMPLIFY 
LOCATION  TO-PORT  FROM-PORT  SAME-AS  PATROL 
POSSIBLE-REPORT  CROSSPATHS  GRAZE  WENT-BEFORE 
WENT-AFTER  BLOCKED-FROM  DISSIMILAR  SWR 
SIMPLY-WITHIN-REACH  WITHIN-REACH  NOT-FIRST 
NOT-LAST  ALIAS  COURSEFROM  SPEEDFROM) ) 

(PUTPROPS  CLASS  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"a  "  3  T))) 

(PUTPROPS  OWNSHIP  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"the  OWNSHIP"  T) ) ) 

(PUTPROPS  PLATFORM  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"a  platform"  T) 

("the  platform  "  2))) 

(PUTPROPS  CONTACT  PRINFORMS  ( (2  "  is  "  (MODIFIER) 

"a  contact"  T) 

("the  contact  "  2))) 

(PUTPROPS  SIGHTING  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"a  sighting  of  "  2  T) 

(3  "  is  "  (MODIFIER) 

"a  sighting  of  ") 

(n  of  "))) 

(PUTPROPS  SOURCE  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"the  source  of  "  2  T) 

("The  source  of  "  2  "  is  "  (MODIFIER) 

3))) 

(PUTPROPS  TOS  PRINFORMS  ((2  "  occurred  at  "  3  T) 

("The  time  of  "  2  "  is  "  (MODIFIER) 

3))) 

(PUTPROPS  POSITION  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"the  position  of  "  2  T) 

("The  position  of  "  2  "  is  "  (MODIFIER) 

3  T))) 

(PUTPROPS  TYPE  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"a  "  3  T))) 


(PUTPROPS  EMITTER  PRINFORMS  ((3  "  is  "  (MODIFIER) 
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"the  emitter  detected  in  "  3  T))) 

(PUTPROPS  DETECTION  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"a  detection"  T) 

("  the  detection  "  2  T) ) ) 

(PUTPROPS  FIRST-SIGHTING  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"the  first  sighting  of  "  2  T) 
("the  first  sighting  of  "))) 

(PUTPROPS  RADAR-MODE  PRINFORMS  (("Radar  was  "  (MODIFIER) 

"in  mode  "  2  T) ) ) 

(PUTPROPS  RANGE  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"the  range  of  "  2  T) 

(3  "  is  "  (MODIFIER) 

"the  range  of  "))) 

(PUTPROPS  LESS-THAN  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"less  than  "  3  T) ) ) 

(PUTPROPS  STRENGTH  PRINFORMS  (("Signal  at  "  2  "  is  "  (MODIFIER) 

3  T) ) ) 

(PUTPROPS  MODE  PRINFORMS  ( (2  "  is  "  (MODIFIER) 

3  T))) 

(PUTPROPS  GREATER-THAN  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"greater  than  "  3  T) ) ) 

(PUTPROPS  SPEED  PRINFORMS  ( (3  "  is  "  (MODIFIER) 

"the  speed  of  "  2  T) 

(3  "  is  "  (MODIFIER) 

"the  speed  of  "))) 

(PUTPROPS  LAND-DIST  PRINFORMS  ((2  "  is  "  3  "  miles  from  land"  T) ) ) 

(PUTPROPS  REACHABLE-BY-A-COMBATANT  PRINFORMS  (("It  is  "  (MODIFIER) 

"the  case  that  some  combatant" 

T 

"could  have  sailed  to  the  position  of  " 

2  T 

"  by  the  time  of  the  sighting" 

T) ) ) 

(PUTPROPS  MEDIUM  PRINFORMS  (("The  medium  of  "  2  "  is  "  (MODIFIER) 

3  T))) 

(PUTPROPS  INSIDE  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"inside  "  3  T) 

("  is  "  (MODIFIER) 

"inside  "  3  T) ) ) 

(PUTPROPS  INSIDE-A-MERCHANTLANE  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"inside  a  merchantlane"  T) 
("  is  "  (MODIFIER) 


( 
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"inside  a  merchantlane" 

T) )) 

(PUTPROPS  MERCHANTLANE  PRINFORMS  ((2  "is  "  (MODIFIER) 

"a  merchant  lane"  T) 

'  ("  the  merchantlane  "  2  T) ) ) 

(PUTPROPS  IN-LANE  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"in  the  merchantlane  "  2  T) 

("  is  "  (MODIFIER) 

"in  the  merchantlane  "  2  T) ) ) 

(PUTPROPS  SUCCESSOR  PRINFORMS  ( (3  "  is  "  (MODIFIER) 

"the  successor  (in  time)  of  "  2  T) ) ) 

(PUTPROPS  COURSE  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"the  course  of  "  2  T) 

(3  "  is  "  (MODIFIER) 

"the  course  of  "))) 

(PUTPROPS  ROUGHLY-THE-SAME-COURSE-AS  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"roughly  the  same  course  as  " 

2  T))) 

(PUTPROPS  ROUGHLY-THE-SAME-SPEED-AS  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"roughly  the  same  speed  as  " 

2  T))) 

(PUTPROPS  ID  PRINFORMS  ((2  "  is  "  (MODIFIER) 

3  T))) 

(PUTPROPS  ID- AMPLIFY  PRINFORMS  ((2  "  is  "  (MODIFIER) 

3  T))) 

(PUTPROPS  LOCATION  PRINFORMS  (("The  location  of  "  2  "  is  "  (MODIFIER) 

3  T))) 

(PUTPROPS  TO-PORT  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"the  destination  port  of  "  2  T) ) ) 

(PUTPROPS  FROM-PORT  PRINFORMS  ((3  "  is  "  (MODIFIER) 

"the  starting  port  of  "  2  T) ) ) 

(PUTPROPS  SAME-AS  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"the  same  as  "  3  T) ) ) 

(PUTPROPS  PATROL  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"a  patrol"  T) ) ) 

(PUTPROPS  POSSIBLE-REPORT  PRINFORMS  (("One  of  the  reports  from  "  3 

"  concerns  " 

2  T))) 

(PUTPROPS  CROSSPATHS  PRINFORMS  (("The  path  from  ’  2  "  to  "  3  T  "  does  " 
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(MODIFIER) 

"cross  the  path  from  " 

T  4  ■  to  "  5  T))> 

(PUTPROPS  GRAZE  PRINFORMS  (("The  path  from  "  2  *  to  "  3  T  ’  does  " 

(MODIFIER) 

"graze  the  path  from"  T  4 
"  to  " 

5  T))) 

(PUTPROPS  WENT-BEFORE  PRINFORMS  (("A  ship  moving  from  "  4  "  to  "  2  T 

"  between  the  times  " 

5  "  and  "  3  T 
"could  " 
(MODIFIER) 


from  " 


n 


"have  avoided  sighting  by  a  patrol  travelling 

T  6  "  to  "  8 
"  between  " 

7  "  and  "  9 


by  traversing  the  patrol  viewing  area  before  the  flight" 

T))) 


(PUTPROPS  WENT-AFTER  PRINFORMS  (("A 


ship  moving  from  "  4  "  to  "  2  T 
"  between  the  times  " 

5  "  and  "  3  T 
"could  " 
(MODIFIER) 


froirf  " 


"have  avoided  sighting  by  a  patrol  travelling 


T  6  "  to  "  8 
"  between  " 

7  "  and  "  9  T 

"by  traversing  the  patrol  viewing  area  after  the  flight" 

T))) 


(PUTPROPS  BLOCKED-FROM  PRINFORMS  (("A  passage  from  "2"  to  "3"  is" 

(MODIFIER) 

"counter indicated" 
T))) 


(PUTPROPS  DISSIMILAR  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"dissimilar  to  "  3  T) ) ) 

(PUTPROPS  SWR  PRINFORMS  (("A  ship  at  "  2  "  at  time  "  3  "  could  "  T 

(MODIFIER) 

"reach  "  4  "  at  time  "  5  T 
"  by  travelling  at  top  speed  (or  less)" 
T))) 


(PUTPROPS  SIMPLY-WITHIN-REACH  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"within  travel  distance  of  " 


i 
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3  T))> 

(PUTPROPS  WITHIN-REACH  PRINPORMS  ((2  "  is  "  (MODIFIER) 

"reachable  from  "  3  T 

"even  considering  possible  patrol  overflights" 

T))) 

(PUTPROPS  NOT-FIRST  PRINFORMS  ((2  "  is  "  (MODIFIER) 

"other  than  a  first  sighting  of  its  platform" 

T))) 

(PUTPROPS  NOT-LAST  PRINFORMS  ( (2  "  is  "  (MODIFIER) 

"other  than  a  last  sighting  of  its  platform" 

T))) 

(PUTPROPS  ALIAS  PRINFORMS  ((3  "  4S  "  (MODIFIER) 

"really  "  2  T) ) ) 

(PUTPROPS  COURSEFROM  PRINFORMS  (("The  course  from  "2"  to  "3"  is" 

(MODIFIER) 

4  T))) 

(PUTPROPS  SPEEDFROM  PRINFORMS  (("To  move  from  "  2  "  to  "  4  T  "between  " 

3  "  and  "  5 

"  implies  a  speed  of  " 

6  T))) 

(RPAQQ  STATES  ( <EXPLTREE>  <PLATIS>  <VALIS>  <ATTIS>  <TYPIS>  <IDIS> 
<IDAMPIS>  <WHATFORM>  <WHOSE2FORM>  <WHOSEFORM>  <TELLABT> 
<WHEREFORM>  <WHEREITEM>  <WHAT2FORM>  <TYPE2>  <ID2>  <IDAMP2> 
<OCCURNUM>  <OTHER2>) ) 

(PUTPROPS  <EXPLTREE>  QHPRODS  ( (Q  "-uit"  :  (PROGN  (TERPRI) 

(PRIN1 

"Leaving  EXPLAIN") 
(TERPRI) 

(SETQ  DONEFLG  T) ) ) 
(SAVE  "memory"  s  (PROGN  (TERPRI) 

(PR INI 

"On  file:  ") 
(MEMSAVE 
(READ) ) 
(CLEARBUF) 
(TERPRI))) 

(NEW  "rule"  :  (PROGN  (TERPRI) 

(DEFINEPD) 

(APPLYRULE 

(CAR  PRODUCTIONS)) 
(CLEARBUF) 

(TERPRI))) 

(CHANGE  "confidence  in  the  rule" 

IRULENAME  (=  RN) 

• 

(CHANGECON  RN) ) 

(BREAK  :  (PROGN  (BREAK1  NIL  T  Explain) 
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(TERPRI) 

(CLEARBUF) ) ) 

[DISPLAY  :  (COND  (DSPLAYPLG  (DSPTOP) ) 

(T  (TERPRI) 

(PRIN1 

"Sorry,  but  the  display  is  not  enabled.") 

(TERPRI] 

(IS  ( <PLATIS>  <VALIS>  <ATTIS>)) 

(WHY  "is"  [ASSERTION  (=  NODE) 

• 

( IMPLIESASRT  NODE)) 

(HOW  "does  rule"  [RULE  (=  RUL) 

"apply  to  "  [ASSERTION  (*  NODE) 

(RULEXP  RUL  NODE)) 

(WHAT  (IS  ARE) 

<WHAT2FORM> 

(=  WHATANS) 

(PRETTYANS  WHATANS)) 

(WHOSE  <WHOSEFORM>  (=  WHOSEANS) 

• 

(PRETTYANS  WHOSEANS)) 

(TELL  "me  about"  <TELLABT>) 

(HELP  :  (HLPEXPLN) ) 

(WHERE  <WH EREFORM> ) 

(WHO  "is"  ( ~  A) 

( <TYPE2>  <ID2>  <IDAMP2>  <OTHER2>)) 
(REPORT  :  (RECAPCONCS) ) ) ) 

(PUTPROPS  <PLATIS>  QHPRODS  [([PLATFORM  (=  PLAT) 

(~  A  AN) 

( <TYPIS>  <IDIS>  <IDAMPIS>) 

(=  WHAF) 

• 

(YESNO  (JUGGLE  WHAF  PLAT]) 

(PUTPROPS  <VALIS>  QHPRODS  [ ( <WHOSE2FORM>  JWHOSE2RES  (=  VAL58) 

(YESNO  (JUGGLF  WHOSE2RES2  VAL58] ) 

(PUTPROPS  <ATTIS>  QHPRODS  [ ( <WHATFORM>  JWHATRES  (=  VAL57) 

(YESNO  (APPEND  WHATRES2  (CONS  VAL571) 

(PUTPROPS  <TYPIS>  QHPRODS  (([TYPE  (=  TYPEN) 

(LIST  (QUOTE  TYPE) 

TYPEN) ) ) ) 

(PUTPROPS  <IDIS>  QHPRODS  (([ID  (*  IDN) 

(LIST  (QUOTE  ID) 

IDN) ) ) ) 

(PUTPROPS  <IDAMPIS>  QHPRODS  (UID-AMP  («  IDA) 
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(LIST  (QUOTE  ID- AMPLIFY) 

IDA) ) ) ) 

(PUTPROPS  <WHATFORM>  QHPRODS  ((THE  1 RELATION  («  RELNM) 

"OF"  (OBJECT  («  OBJ) 

(WHATFORMFN  RELNM  OBJ)))) 

(PUTPROPS  <WHOSE2FORM>  QHPRODS  (((VALUE  (*  VAL59) 

(A  AN  THE  a  an  the) 

(RELATION 
(=  RELN4) 

( WHOS E2 FORMFN  VAL59  RELN4 ) ) ) ) 

(PUTPROPS  <WHOSEFORM>  QHPRODS  (((RELATION  (  =  RELNE) 

"is"  (VALUE  (*  VAI.61) 

( WHOS E2 FORMFN  VAL61  RELNE)))) 

(PUTPROPS  <TELLABT>  QHPRODS  [[((RELATION  (OBJECT  (VALUE) 

(»  ITEMN) 

• 

(PROG  (ISONE) 

(TERPRI) 

[MAPC  ASSERTIONS  (FUNCTION  (LAMBDA 

(X) 

(COND 

( (MEMB  ITEMN 

(GETUPLE  X)) 
(PRETTY AS SR  X) 

(SETQ  ISONE  T] 

(COND  ((NOT  ISONE) 

(PRINl  "No  information  about  that.") 

(TERPRI] 

((RULENAME  (=  RUNM) 

(PROGN  (TERPRI) 

(FANCYPROD  RUNM] ) 

(PUTPROPS  <WHEREFORM>  QHPRODS  [(IS  <WHEREITEM>) 

(WAS  (PLATFORM  (=  PLNM) 

"at  time"  :  (PROG  (TME) 

(SETQ  TME  (READ)) 

(CLEARBUF) 

(TERPRI) 

(SETQ  EXPLAINFLAG  T) 

(PRINl  (PLATPOS  PLNM  TME)) 

(SETQ  EXPLAINFLAG  NIL) 

[COND  (DSPLAYFLG  (TERPRI) 

(PRINl 

"Also,  see  the  display.”) 
(TERPRI) 

(WAITER) 

(DSPCMD 

(CONCAT  "PTR  " 

PLNM] 
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(TERPRI] ) 

(PUTPROPS  <WHEREITEM>  QHPRODS  [ ( 1  PLATFORM 
(=  PLTNM) 

(PROGN  (TERPRI) 

(SETQ  EXPLAINFLAG  T) 

(PRIN1  (PLATPOS  PLTNM  CURTIME) ) 

(SETQ  EXPLAINFLAG  NIL) 

ICOND  (DSPLAYFLG  (TERPRI) 

(PRIN1  "Also,  see  the  display.") 
(TERPRI) 

(WAITER) 

(DSPCMD  (CONCAT  "PTR  "  PLTNM] 

(TERPRI) ) ) 

(UMLANE  1  STORM) 

(«  LANM) 

• 

(PROGN  (TERPRI) 

IPRIN1  (CDADAR  (RETRIEVER  (LIST  (QUOTE  LOCATION) 

LANM 

(QUOTE  *LOC] 

ICOND  (DSPLAYFLG  (TERPRI) 

(PR INI  "Also,  see  the  display.") 
(TERPRI) 

(WAITER) 

(DSPCMD  (CONCAT  "PTR  "  LANM] 

(TERPRI]) 

(PUTPROPS  <WHAT2FORM>  QHPRODS  ( ( <WHATFORM>) 

(I PLATFORM  (=  PA) 

( WHAT2 FORMFN  PA)))) 


(PUTPROPS  <TYPE2>  QHPRODS  l ( I TYPE  (=  TYP) 


(PRETTYANS 

(RETRIEVER  (LIST 


(QUOTE 
(QUOTE 
TYP] ) 


TYPE) 

*WHO) 


(PUTPROPS  <ID2>  QHPRODS  K1ID  (-  IDB) 

• 

(PRETTYANS  (RETRIEVER 

(LIST  (QUOTE  ID) 

(QUOTE  *WHO) 

IDB]) 

(PUTPROPS  <IDAMP2>  QHPRODS  1(1 ID-AMP  (»  I  DM) 

(PRETTYANS 

(RETRIEVER  (LIST  (QUOTE 

ID- AMPLIFY) 
(QUOTE  *WHO) 
IDM]  ) 


(PUTPROPS  <OCCURNUM>  QHPRODS  ( ( 1SMALLNUMB  (>  TIMES) 
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(OCCURPRINT  TIMES  NODE)))) 

(POTPROPS  <OTHER2>  QH PRODS  [ ( 1 RELATION 
(=  RM) 

• 

(PRETTYANS  (APPEND  (RETRIEVER  (LIST  RM  (QUOTE  *WHO) ) ) 

(RETRIEVER  (LIST  RM  (QUOTE  *WHO) 

(QUOTE  *IGN] ) 

(RPAQQ  NEWEXPFNS  (ASSRPRINT  CHANGECON  EXPLAIN  GAMF  HLPEXPLN  IMPLIES ASRT 

JUGGLE  KAKEPRINT  MEMSAVE  MODIFIER  NEWVALOBJ 
NICEANSWER  OCCURPRINT  PRETTYANS  PRETTYASSR 
PRINTRULEASSR  RECAPCONCS  RESOUT 
RESULTPRINTER  RULEXP  WHAT2FORMFN  WHATFORMFN 
WHOSE2FORMFN  YESNO  DSPEXP) ) 

(DEFINEQ 

[1481 

(ASSRPRINT 

[LAMBDA  (PRINSPEC)  (*  edited: 

"24-Aug-79  12:46") 

(*  This  is  the  workhorse  of  the  assertion 
prettypr inter .  It  receives  a  PRINFORM  as  an 
argument,  and  prints  in  accordance  with  what  is 
found  there.  Strings  are  printed  as  found. 

Numbers  refer  to  "slots"  in  the  GETUPLE  of  the 
assertion  in  question.  Lists 

(assumed  to  be  functions)  are  evaluated  and  must  do 
their  own  printing.  T  causes  a  TERPRI.) 


(COND 

( (STRINGP  PRINSPEC) 

(PRIN1  PRINSPEC)) 

KNUMBERP  PRINSPEC) 

(PRIN1  (CAR  (NTH  BODY  PRINSPEC] 

((AND  (LISTP  PRINSPEC) 

(OR  (NULL  LSTFLG) 

OVERCONF ) ) 

(EVAL  PRINSPEC)) 

((EQ  PRINSPEC  T) 

(PRIN1  ".")  I 

(TERPRI]) 

[1491 

(CHANGECON 

[LAMBDA  (RLNME1)  (*  edited: 

"  7 -Aug-7 9  08:19") 

(*  Allows  the  user  to  change  the  confidence  in  the 
rule  that  is  its  argument.  This  change,  while 
permanent  for  that  invocation  of  STAMMER 
(until  CHANGECON  is  called  again) ,  does  not  affect 
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future  invocations  unless  the  rules  are  saved 
(by  doing  MAKEFILE  (RULES)).  The  changed  confidence 
IS  reflected  in  all  inferences  done  before  the 
CHANGECON,  due  to  the  dynamic  calulation  of 
confidence. ) 


(TERPRI) 

(PRIN1  "  Present  confidence  is:  ") 
(PRIN1  (GETPROP  RLNME1  (QUOTE  CONF) ) ) 
(TERPRI) 

(PRINl  "  Confidence  should  be:  ") 
(PUTPROP  RLNME1  (QUOTE  CONF) 

(READ) ) 

(CLEARBUF) 

(TERPRI] ) 


[150] 


(EXPLAIN 

[LAMBDA  NIL  (*  edited: 

"24-Aug-79  17:55") 

(*  The  top  level  of  the  explanation  system. 

Most  of  this  function  is  initialization  of  variables 
used  by  the  explanation  productions. 

The  most  notable  feature  is  the  use  of  ERSETQ  to 
allow  the  user  to  escape  back  to  the  top  level  of 
explanation  via  control-E  if  and  when  he/she  gets 
totally  lost.) 


(PROG  (DONEFLG  [PLATFORM  (CONS  (QUOTE  CONNOLE) 

(RETRIEVES  (QUOTE  PLATFORM) 

(QUOTE  *] 

(MLANE  (RETRIEVES  (QUOTE  MERCHANTLANE) 

(QUOTE  *))) 

(STORM  (RETRIEVES  (QUOTE  STORM) 

(QUOTE  *))) 

(ID  (QUOTE  (FRIEND  HOSTILE  UNKNOWN))) 

(ID-AMP  (QUOTE  (NON-MIL  MIL-BATTLE  MIL-AUXIL  UNKNOWN) 
)) 

(TYPE  (QUOTE  (CARRIER  CRUISER  DESTROYER  FRIGATE 

AMPH IB- ASSAULT  AMPHIB-DOCK 
PATROL-BOAT  MINELAYER 
MINESWEEPER  LANDING  SUB  OILER 
AMMUNITION  STORES 
DESTROYER-TENDER  SUB-TENDER 
BUOY-TENDER 

PATROL- CRAFT- TENDER  REPAIR 
RESEARCH  INTELLIGENCE  TUG 
MERCHANT  FISHING  PASSENGER 
PLEASURE  MISCELLANEOUS  BOMBER 
FIGHTER  RECONNISANCE) ) ) 

VALUE  OBJECT) 

(SETQ  RULENAME  PRODUCTIONS)  I 

(SETQ  RELATION  RELATIONS)  I 
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(MAPC  ASSERTIONS  (FUNCTION  NEWVALOBJ) ) 

LOOP (OR  (ERSETQ  (QHTAKE  "Question?  "  <EXPLTREE>) ) 
(GO  LOOP)) 

(COND 

(DONEFLG  (RETURN)) 

(T  (GO  LOOP!) 


[1511 


(GAMF 

[LAMBDA  (WLK  OVERRIDE) 
(PROG  (CONFI  ACON) 


(*  edited: 

"  8-Aug-79  19:49") 


(*  GAMF  generates  an  appropriate  modifier  for  an 
assertion  based  on  the  confidence  of  the  assertion.) 


(SETQ  CONFI  (OR  OVERRIDE  (GETCON  WLK)))  I 

(SETQ  ACON  (ABS  CONFI)) 

(COND 

( (EQP  ACON  1.0)) 

( ( FGREATERP  ACON  .98) 

(PRIN1  "definitely  ")) 

((FGREATERP  ACON  .9) 

(PRIN1  "almost  certainly  ")) 

((FGREATERP  ACON  .7) 

(PRIN1  "very  probably  ")) 

((FGREATERP  ACON  .45) 

(PRIN1  "probably  ")) 

((EQP  ACON  0.0) 

(PRIN1  "not  known  to  be  ") 

(RETURN) ) 

(T  (PRINl  "somewhat  ") 

(COND 

( (FLESSP  CONFI  0.0) 

(PRINl  "un"))) 

(PRINl  "likely  to  be  ") 

(RETURN) ) ) 

(COND 

((FLESSP  CONFI  0.0) 

(PRINl  "not  "]) 

[1521 

(HLPEXPLN 

[LAMBDA  NIL  (*  edited: 

"24-Jul-79  18:56") 

(PRINl  "Sorry,  no  help  yet.") 

(TERPRI] ) 

[1531 

( IMPLIES ASRT 

[LAMBDA  (NODE)  (*  edited: 

"17 -Aug-79  14:14") 


(PROG  (X) 
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(TERPRI) 

(COND 

((GETPROP  NODE  (QUOTE  TDB) ) 

(PRIN1 

"That  assection  is  pact  of  the  technical  data  base”) 
(TERPRI) 

(RETURN) ) 

(T)) 

(SETQ  X  (GETPROP  NODE  (QUOTE  DERIVE*))) 

(COND 

((AND  (NULL  X) 

(EQP  (GETCON  NODE) 

0)  ) 

(PRIN1  "Assertion  based  on  the  absence  of  information") 
(TERPRI) ) 

((GETPROP  (CAR  (GETUPLE  NODE)) 

(QUOTE  ORACLE)) 

(PRIN1  "That  assertion  was  computed  by  the  oracle  ") 
(PRIN1  (CAR  (GETUPLE  NODE))) 

(TERPRI) ) 

(X  (PRIN1  "STAMMER  applied  the  rule(s)") 

(TERPRI) 

IMAPC  X 

(FUNCTION  (LAMBDA  (Y) 

(PROGN  (COND 

((MEMBER  (CAR  Y) 

RULE) ) 

(T  (SETQ  RULE 

(APPEND  (LIST  (CAR  Y) ) 

RULE] 

(PRINl  (CAR  Y)) 

(SPACES  1] 

(TERPRI) ) 

(T  (PRINl  "The  information  came  directly  from  a  message.") 
(TERPRI]) 


[1541 


(JUGGLE 

[LAMBDA  (PAIR  INSERTITEM)  (*  edited: 

"  7-Aug~79  08:24") 

(*  JUGGLE  return  a  three  element  list  constructed  by 
placing  INSERTITEM  between  the  elements  of  PAIR. 

It's  non-destructive,  and  costs  due  to 
(possibly  unnecessary)  copying.) 


(LIST  (CAR  PAIR) 
INSERTITEM 
(CADR  PAIR]) 


[155] 


(MAKEPRINT 

[LAMBDA  (RELN) 


(*  edited: 

"  7-Aug-79  08:28") 
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(*  MAKEPRINT  is  provided  as  an  assistance  in 
creating  PRINFORMS.  Given  a  relation  name,  MAKEPRINT 
prompts  for  new  PRINFORMS,  after  printing  the 
existing  forms,  if  any.  To  terminate  addition,  type 
STOP. ) 


(PROG  (PFORM  NEWFORM) 

MP1  (PRIN1  "For  the  relation  ") 

(PRIN1  RELN) 

(TERPRI) 

(PRIN1  "use  the  prinforms  ") 

(SETQ  PFORM  (GETPROP  RELN  (QUOTE  PRINFORMS))) 

ICOND 

(PFORM  (MAPC  PFORM  (FUNCTION  (LAMBDA  (X) 

(TERPRI) 

(SPACES  3) 

(PRINl  X] 

MPLP (TERPRI) 

(SPACES  3) 

(SETQ  NEWFORM  (READ)) 

(COND 

((EQ  NEWFORM  (QUOTE  STOP)) 

(GO  EXLOOP))) 

(SETQ  PFORM  (APPEND  PFORM  (CONS  NEWFORM))) 

(GO  MPLP) 

EXLOOP 

(PUTPROP  RELN  (QUOTE  PRINFORMS) 

PFORM) 

(TERPRI]) 

[1561 

(MEMSAVE 

[LAMBDA  (FEE)  (*  edited: 

"  7-Aug-79  08:30") 

(*  MEMSAVE  saves  the  contents  of  memory 
lexclusive  of  stream  suspensions)  on  a  user 
specified  file.  This  is  made  simple  since  memory  can 
be  set  up  completely  through  standard  fileCOMS, 
which  are  assigned  to  the  user  file  name.) 


(SET  (FILECOMS  FEE) 
MEMORYCOMS) 
(MAKEFILE  FEE) 

(TERPRI) 

(PRINl  "Memory  saved.") 
(TERPRI) 

(CLEARBUF] ) 
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(MODIFIER 

[LAMBDA  NIL  <*  edited: 

"22-Aug-79  20:04") 

(*  MODIFIER  provides  a  way  for  GAMF  to  be  used  in 
PRINFORMs  while  allowing  the  user  to  remain 
blissfully  unaware  of  how  to  refer  to  the  node  he's 
describing.  Since  NODE  is  used  freely  here,  MODIFIER 
should  ONLY  be  used  in  PRINFORMs,  never  as  a 
standard  function  call.) 


(PROG  (CON) 

(GAMF  NODE  OVERCONF) 

(COND 

([AND  (NOT  OVERCONF) 

(NOT  (MEMBER  ( SETQ  CON  (GETCON  NODE)) 
(QUOTE  (1.0  0.0  -1.0] 

(PRIN1  "(") 

(PRINl  (TWO- PLACE  CON)) 

(PRINl  ")  "]) 


[158] 


(NEWVALOBJ 

[LAMBDA  (ARRT) 


(*  edited: 
"24-Aug-79  12:26") 


(*  This  function  sets  up  lists  of  object  and  value 
slot  fillers  that  are  presently  used  in  memory. 
These  lists  are  then  used  by  the  explanation  system 
productions.  In  a  standard  TWOARG  assertion,  the 
format  of  the  assertion  is  (REL  OBJ  VAL).) 


(PROG  (VL  OJ  TUPLE) 

(COND 

( (LESSP  (LENGTH  (SETQ  TUPLE  (GETUPLE  ARRT))) 
3) 

(RETURN))) 

(SETQ  VL  (CADDR  TUPLE)) 

(SETQ  OJ  (CADR  TUPLE)) 

[COND 

( (LISTP  VL)) 

( (NUMBERP  VL) ) 

( (MEMB  VL  VALUE)) 

(T  (SETQ  VALUE  (CONS  VL  VALUE] 

(COND 

((LISTP  OJ)) 

((NUMBERP  OJ)) 

((MEMB  OJ  OBJECT)) 

(T  (SETQ  OBJECT  (CONS  OJ  OBJECT]) 
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(NICE ANSWER 

[LAMBDA  (ANSI)  (*  edited: 

"  7 -Aug-7 9  08:38") 

(*  Ocassionally ,  you  don’t  want  to  print  a  whole 
assertion,  but  rather  just  a  value  or  object,  but 
with  a  confidence  indicator  attached. 

NICEANSWER  does  this.  It  assumes  that  its  argument 
is  a  single  element  of  a  RETRIEVER  answer.) 


(GAMF  (CAR  ANSI)) 
(PRIN1  ( CDADR  ANSI)) 
(TERPRIl ) 


[1601 


(OCCURPRINT 

[LAMBDA  (TIMES  NODE) 


(*  edited: 


(PROG 


"24-Aug-79  17:54") 

(X  Z) 

(SETQ  X  (GETPROP  NODE  (QUOTE  DERIVE*))) 

[for  y  in  X  UNTIL  (ZEROP  TIMES) 
do  (COND 

((EQUAL  (CAR  Y) 

RULE) 

(SETQ  TIMES  (SUB1  TIMES)) 

(SETQ'  Z  Y] 

(PRINTRULEASSR  Z) 

(QHTAKE  "Another  occurrence?"  ( Icarriagereturn  <OCCURNUM>J) 


[1611 


(PRETTYANS 

[LAMBDA  (ANSLST)  (*  edited: 

"  7 -Aug-79  08:39") 

(*  PRETTYANS  gets  whatever  RETRIEVER  returns  and 
uses  NICEANSWER  to  print  the  results,  if  any. 

If  there  are  no  results,  PRETTYANS  admits 
ignorance. ) 


(TERPRI) 

(COND 

((NULL  ANSLST) 

(PRIN1  "I  don’t  know.") 

(TERPRI) ) 

(T  (MAPC  ANSLST  (FUNCTION  NICEANSWER]) 


[162] 


( PRETTYASSR 

[LAMBDA  (NODE  FORMAT  OVERCONF) 


(*  edited: 
"24-Aug-79  12:45") 
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(*  PRETTYASSR  is  the  assertion  prettypr inter . 

Every  relation  is  assumed  to  have  a  list  of 
PRINFORMs  on  its  property  list  that  will  be  used  to 
guide  the  printing  of  assertions  with  that  relation. 
PRETTYASSR  is  called  on  an  assertion  with  a  selector 
as  to  which  PRINFORM  to  use. 

The  default  PRINFORM  is  the  first. 

If  there  are  no  PRINFORMs  stored,  defaults  are  used, 
but  their  beauty  is  not  guaranteed.) 


(PROG  (BODY  FORMLST  USEFORM  LSTFLG) 

(COND 

( (LISTP  NODE) 

(SETQ  LSTFLG  T) 

(SETQ  BODY  NODE)) 

(T  (PRIN1  NODE) 

(PRIN1  ") 

[COND 

( (MEMB  NODE  ASSERTION) ) 

(T  (SETQ  ASSERTION  (CONS  NODE  ASSERTION] 
(SETQ  BODY  (EVAL  NODE] 


(COND 

((NULL  FORMAT) 

(SETQ  FORMAT  1))) 

(SETQ  FORMLST  (GETPROP  (CAR  BODY) 

(QUOTE  PRINFORMS))) 

(COND 

((GREATERP  FORMAT  (LENGTH  FORMLST)) 

(SETQ  FORMAT  1))) 

[COND 

[(NULL  FORMLST) 

( SELECTQ  (LENGTH  BODY) 

[2  (SETQ  USEFORM  (QUOTE  (2  "  is  "  (MODIFIER) 

"  a  "  1  T] 

[3  (SETQ  USEFORM  (QUOTE  (3  "  is  "  (MODIFIER) 

"  a  "  1  "  of  "  2  T] 

(SETQ  USEFORM  (FOR  I  FROM  1  TO  (LENGTH  BODY) 

COLLECT  I] 

(T  (SETQ  USEFORM  (CAR  (NTH  FORMLST  FORMAT] 

(MAPC  USEFORM  (FUNCTION  ASSRPRINT] ) 


I 

I 


[1631 


(PRINTRULEASSR 

[LAMBDA  (RULEASSRTS)  (*  edited: 

"17-Aug-79  13:24") 

(TERPRI) 

(COND 

[RULEASSRTS  (PRIN1  "The  rule  was  applied  with  the  assertions") 
(TERPRI) 

[for  Y  in  (CDR  RULEASSRTS) 
do  (TERPRI) 

(COND 

[(ATOM  Y) 

(COND 
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( (FLESSP  0  (GETCON  Y) ) 

( PRETTYASSR  Y) ) 

(T  (PRETTYASSR  Y  NIL  .4) 

(TAB  7) 

(PRIN1  "(condition  is  no  longer  true)") 
(TERPRIl 
(T  (COND 

[  (EQ  (CAR  Y) 

(QUOTE  NOT)) 

(COND 

((FLESSP  (GETCON  (CADR  Y) ) 

0) 

(PRETTYASSR  (CADR  Y) ) ) 

(T  (PRETTYASSR  (CADR  Y) 

NIL  -.4) 

(TAB  7) 

(PRINl  "(no  longer  valid)") 
(TERPRIl 
((EQ  (CAR  Y) 

(QUOTE  UNLESS)) 

(CONI) 

((FLESSP  0  (GETCON  (CADR  Y) ) ) 

(PR ETTAS SR  (CADR  Y) 

NIL  0.0) 

(TAB  7) 

(PRINl  "(no  longer  valid)") 

(TERPRI) ) 

(T  (PRETTYASSR  (CADR  Y1 

(COND 

((AND  DSPLAYFLG  (DSPEXP  RULEASSRTS) ) 

(TERPRI) 

(PRINl  "Also*  see  the  display.") 

(TERPRI) 

(WAITER) 

(DSPCMD  (DSPEXP  RULEASSRTS))) 

(T  (TERPRIl 

(T  (PRINl  "The  rule  was  not  applied  to  derive  that  assertion") 
(TERPRIl ) 


[1641 


(RECAPCONCS 
[LAMBDA  NIL 

(TERPRI) 

(TERPRI) 

(MAPC  ASSERTION  (FUNCTION  PRETTYASSR]) 


(*  edited: 

"  3-Aug-79  14:07") 


[1651 


(RESOUT 

[LAMBDA  NIL 


(*  edited: 

"  7 -Aug-79  07:49") 


(*  RESOUT  causes  the  results  of  rule  firings  to  be 
printed  at  the  user's  terminal,  using  the  function 
RESULTPR INTER.  First,  it  removes  duplications  of 
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conclusions  (so  a  single  conclusion  is  printed  only 
once) . ) 


(SETQ  RESULTLIST  (INTERSECTION  RESULTLIST  RESULTLIST) ) 

(MAPC  RESULTLIST  (FUNCTION  RESULTPRINTER) ) 

(SETQ  RESULTLIST  NIL]) 

[1661 


(RESULTPRINTER 

[LAMBDA  (RES1)  (*  edited: 

"17-Aug-79  17:22") 

(*  Results  can  either  be  a  report,  in  which  case  a 
report  flag  is  printed  and  then  the  report  itself  is 
printed  (literally) ,  or  assertions,  which  are 
handled  by  the  assertion  prettypr inter . ) 


(COND 

( (LISTP  RES1) 

(PRIN1  "Report:  ") 

(MAPC  (CDR  RES1) 

(FUNCTION  PRIN1)) 

(TERPRI) ) 

((NOT  (MEMB  (CAR  (GETUPLE  RES1) )  I 

DULLREL) )  I 

(PRETTYASSR  RES11) 

[167] 


(RULEXP 

[LAMBDA 

(PROG 


technical 


(RULE  NODE)  (*  edited: 

"  9-Aug-79  11:49") 

(X  Z  COUNT) 

(COND 

((GETPROP  RULE  (QUOTE  ORACLE)) 

(PRIN1  "That  assertion  was  computed  by  an  oracle") 
(TERPRI) 

(RETURN) ) 

((GETPROP  NODE  (QUOTE  TDB)  ) 

(PRINl  "That  assertion  came  from  the 
data  base") 

(TERPRI) 

(RETURN) ) 

(T)) 

(SETQ  X  (GETPROP  NODE  (QUOTE  DERIVE*))) 

(COND 

((NULL  X) 

(PRINl  "That  assertion  came  from  a  message.") 
(TERPRI) 

(RETURN) ) ) 

(SETQ  COUNT  2) 

[for  Y  in  X  until  (ZEROP  COUNT) 
do  (COND 

((EQUAL  (CAR  Y) 
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RULE) 

(SETQ  COUNT  (SUB1  COUNT)) 

(SETQ  Z  YJ 

(COND 

((EQUAL  COUNT  1) 

(PRINTRULEASSR  Z)  ) 

((ZEROP  COUNT) 

(TERPRI) 

(QHTAKE  "Which  occurrence?"  <OCCURNUM>)) 

(T  (PRIN1 

"The  rule  was  not  applied  to  derive  that  assertion") 
(TERPRI 1) 


[1681 


(WHAT2FORMFN 

[LAMBDA  (PL)  (*  edited: 

"  7 -Aug-7 9  08:48") 

(*  This  function  collects  answers  to  the  question 
"what  is  <some  platform>"  by  looking  in  the  memory 
for  the  things  a  platform  can  be.) 


(APPEND  (RETRIEVER  (LIST  (QUOTE 

PL 

(QUOTE 

(RETRIEVER  (LIST  (QUOTE 

PL 

(QUOTE 

(RETRIEVER  (LIST  (QUOTE 

PL 

(QUOTE 

(RETRIEVER  (LIST  (QUOTE 

PL 

(QUOTE 


ID) 

*WHA)  ) ) 
ID-AMPLIFY) 

*WHA) ) ) 
TYPE) 

*WHA) ) ) 
CLASS) 

*WHAJ ) 


[169] 


(WHATFORMFN 

[LAMBDA  (REL  OBJ)  (*  edited: 

"  7-Aug-79  08:50") 

(*  This  generates 
answers  to  the  other 
form  of  WHAT  questions, 
e.g. 

"what  is  the  rel  of  obj?" 

) 

(PROG  (ANS) 

[SETQ  ANS  (RETRIEVER  (LIST  REL  OBJ  (QUOTE  *VAL] 

(SETQ  WHATRES2  (LIST  REL  OBJ)) 

(SETQ  WHATRES  (MAPCAR  ANS  (FUNCTION  CD ADR) ) ) 

(RETURN  ANSI) 


<DKIBLBR>NEWEXP. LSP. 34 


Page  120 
[1701 


(WHOSE2FORMFN 

I LAMBDA  (VAL  REL)  <*  edited: 

"  7-Aug-79  08:51") 

(*  For  getting  answers 
to  the  question 
"whose  rel  is  val?") 

(PROG  (ANS) 

(SETQ  ANS  (RETRIEVER  (LIST  REL  (QUOTE  *WHO) 

VAL) )) 

(SETQ  WHOSE2RES2  (LIST  REL  VAL)) 

(SETQ  WHOSE2RES  (MAPCAR  ANS  (FUNCTION  CDADR) ) ) 

(RETURN  ANSI ) 

[1711 

(YESNO 

[LAMBDA  (ASSRSPEC)  (*  edited: 

"  7 -Aug-7 9  08:52") 

(*  If  you  don't  want  to  print  an  entire  assertion  or 
even  a  part,  but  just  want  to  answer  yes,  no,  or 
some  confidence  modifier  (like  in  response  to  "is" 
questions) . ) 


(PROG  ( (NDE  (CAR  (GETSTRIP  ASSRSPEC))) 

NDECON) 

(TERPRI) 

(SETQ  NDECON  (GETCON  NDE)) 

(COND 

( (EQP  NDECON  1.0) 

(PRIN1  "Yes")) 

((EQP  NDECON  -1.0) 

(PRIN1  "No")) 

((EQP  NDECON  0.0) 

(PRINl  "I  don't  know")) 

(T  (PRINl  "It's  ") 

(GAMF  NDE))) 

(TERPRI]) 

tl72l 

(DSPEXP 

[LAMBDA  (BOX)  (*  edited: 

"  8-Aug-79  15:47") 

(PROG  ( (DSPOBJECTS  (QUOTE  (PLATFORM  CONTACT  STORM  MERCHANTLANE 

OWNSHIP))) 

(DSPLST  (CONS  (QUOTE  PTR) ) ) 

(BLANK  "  ") 

(COMMA  ",") 

(COUNT  0)) 

[for  X  in  (CDR  BOX) 
do  [COND 

( (LISTP  X) 

(SETQ  X  (CADR  X]  (*  To  deal  With  UNLESS' S 
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etc. ) 

(SETQ  X  (GETUPLE  X)) 

(COND 

((OR  (MEMB  (CAR  X) 

DSPOBJECTS) 

<EQ  (CAR  X) 

(QUOTE  RANGE))) 

(SETQ  DSPLST  (CONS  (COND 

((ZEROP  COUNT) 
BLANK) 

(T  COMMA)) 

DSPLST) ) 

(SETQ  DSPLST  (CONS  (COND 

((EQ  (CAR  X) 

(QUOTE  RANGE)) 
OWNSHIP) 

(T  (CADR  X))) 
DSPLST) ) 


(SETQ  COUNT  (ADD1  COUNT] 

(COND 

( ( IGREATERP  COUNT  1) 

(RETURN  (APPLY  (FUNCTION  CONCAT) 

(DREVERSE  DSPLST]) 

) 

(LOAD  (QUOTE  QH.COM)) 

(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (14818  33280  (ASSRPRINT  14830  .  15593)  (CHANGECON  15597  . 
16372)  (EXPLAIN  16376  .  17885)  (GAMF  17889  .  18799)  (HLPEXPLN  18803  . 
18949)  ( IMPLIESASRT  18953  .  20137)  (JUGGLE  20141  .  20493)  (MAKEPRINT 
20497  .  21474)  (MEMSAVE  21478  .  21971)  (MODIFIER  21975  .  22724)  ( 
NEWVALOBJ  22728  .  23634)  (NICEANSWER  23638  .  24068)  (OCCURPRINT  24072  . 
24481)  (PRETTYANS  24485  .  24893)  (PRETTYASSR  24897  .  26379)  ( 
PRINTRULEASSR  26383  .  27895)  (RECAPCONCS  27899  .  28069)  (RESOUT  28073  . 
28551)  (RESULTPRINTER  28555  .  29089)  (RULEXP  29093  .  30225)  (WHAT2FORMFN 
30229  .  30790)  (WHATFORMFN  30794  .  31269)  (WHOSE2FORMFN  31273  .  31714) 
(YESNO  31718  .  32358)  (DSPEXP  32362  .  33277))))) 

STOP 
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(PILECREATED  "  8-Aug-79  09:11:09"  <DKIBLER>ORACLE.LSP.40  25437 


changes  to:  SPEEDM 

previous  date:  "  7-Aug-79  17:55:13"  <DKIBLER>ORACLE.LSP.39) 


(PRETTYCOMPRINT  ORACLECOMS) 

(RPAQQ  ORACLECOMS  [(VARS  *  ORACLEVARS) 

( IFPROP  (ORACLE  ORTYPE) 

*  ORACLES) 

(FNS  *  ORACLEFNS) 

(DECLARE:  DONTEVAL0LOAD  DOEVAL@COMPILE  DONTCOPY 
COMPILERVARS  (ADDVARS  (NLAMA  WITH I NR) 

(NLAML) 

(LAMA] ) 

(RPAQQ  ORACLEVARS  (ORACLES  MAXSHIPSPEED) ) 

(RPAQQ  ORACLES  (SAME-AS  ROUGHLY-THE-SAME-SPEED-AS 

ROUGHLY-THE-SAME-COURSE-AS  IN-LANE  INSIDE 
GREATER-THAN  LESS-THAN  CROSSPATHS  GRAZE  SWR 
WENT-AFTER  WENT-BEFORE  SUCCESSOR  PREDECESSOR 
RANGE  BEARING  COURSE  SPEED  COURSEFROM  SPEEDFROM) 

) 

(RPAQQ  MAXSHIPSPEED  35) 

(RPAQQ  ORACLES  (SAME-AS  ROUGHLY-THE-SAME-SPEED-AS 

ROUGHLY-THE-SAME-COURSE-AS  IN-LANE  INSIDE 
GREATER-THAN  LESS-THAN  CROSSPATHS  GRAZE  SWR 
WENT-AFTER  WENT-BEFORE  SUCCESSOR  PREDECESSOR 
RANGE  BEARING  COURSE  SPEED  COURSEFROM  SPEEDFROM) 

) 

(PUTPROPS  SAME-AS  ORACLE  T) 

(PUTPROPS  ROUGHLY-THE-SAME-SPEED-AS  ORACLE  T) 

(PUTPROPS  ROUGHLY-THE-SAME-COURSE-AS  ORACLE  T) 

(PUTPROPS  IN- LANE  ORACLE  T) 

(PUTPROPS  INSIDE  ORACLE  T) 

(PUTPROPS  GREATER-THAN  ORACLE  T) 

(PUTPROPS  LESS-THAN  ORACLE  T) 

(PUTPROPS  CROSSPATHS  ORACLE  T) 

(PUTPROPS  GRAZE  ORACLE  T) 

(PUTPROPS  SWR  ORACLE  T) 
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(PUTPROPS  WENT- AFTER  ORACLE  T) 
(PUTPROPS  WENT-BEFORE  ORACLE  T) 
(PUTPROPS  SUCCESSOR  ORACLE  T) 
(PUTPROPS  PREDECESSOR  ORACLE  T) 
(PUTPROPS  RANGE  ORACLE  T) 

(PUTPROPS  BEARING  ORACLE  T) 

(PUTPROPS  COURSE  ORACLE  T) 

(PUTPROPS  SPEED  ORACLE  T) 

(PUTPROPS  SUCCESSOR  ORTYPE  LASTARG) 
(PUTPROPS  PREDECESSOR  ORTYPE  LASTARG) 
(PUTPROPS  RANGE  ORTYPE  LASTARG) 
(PUTPROPS  BEARING  ORTYPE  LASTARG) 
(PUTPROPS  COURSE  ORTYPE  LASTARG) 
(PUTPROPS  SPEED  ORTYPE  LASTARG) 
(PUTPROPS  COURSEFROH  ORTYPE  LASTARG) 
(PUTPROPS  SPEEDFROM  ORTYPE  LASTARG) 


( RPAQQ  ORACLEFNS  (SAME-AS  ROUGHLY-THE-SAME-SPEED-AS 

ROUGHLY-THE-SAME-COURSE-AS  IN-LANE  INSIDE 
GETATTB  GREATER-THAN  LESS-THAN  BEARING  SPEED 
INTERIOR  DISTANCE  DISTOLINE  INLANE  LINPOLY 
CROSSBOUNDARY  SOMELINESEG  TRACKINPOLY 
CROSSLINES  OPSIDES  ROTSENSE  SUBTEND  LANERANGE 
WITHINR  CROSSPATHS  LOCATION  POSS-REPORT 
DISSIMILPLAT  WENT-BEFORE  WENT-AFTER  LOC-TIME 
SWR  SPEEDM  GRAZE  SUCCESSOR  PREDECESSOR 
DIRECTION  RANGE  COURSE  SPEEDAUX  COURSEFROM 
SPEEDFROM) ) 

(DEFINEQ 


[1731 


(SAME-AS 

(LAMBDA  (W  U) 

(EQ  W  un 


(*  edited:  I 

"25-Jul-79  19:16")  I 


(1741 


( ROUGHLY-THE-SAME-SPEED-AS 

[LAMBDA  (Q1  Q2)  (*  edited: 

"  6-Aug-79  20:31") 
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(*  Speeds  are  considered  to  be  roughly  the  same  if 
they  are  within  5  per  cent  of  each  other.) 


(AND  (GREATERP  (PLUS  Q2  (TIMES  Q2  .05))  I 

Ql)  I 

(GREATERP  Ql  (DIFFERENCE  Q2  (TIMES  Q2  .051) 

11751 


(ROUGHLY-THE- SAME-COURSE- AS 

[LAMBDA  (Ql  Q2)  (*  edited: 

"  6 -Aug-7 9  19:20") 

(*  Two  courses  are  considered  to  be  roughly  the  same 
if  they  differ  by  at  most  4.5  percent.) 


(AND  (GREATERP  (PLUS  Q2  4.5) 

Ql) 

(GREATERP  Ql  (DIFFERENCE  Q2  4.51) 

1176] 


(IN- LANE 

[LAMBDA  (MLANE  POS)  (*  edited: 

"  6-Aug-79  19:24") 

(*  If  the  centroid  of  the  position  is  within  5 
nautical  miles  of  the  given  lane,  this  function 
returns  true.) 


(PROG  ((Y  (CENTROID  POS)) 

(X  (LAST  MLANE))) 

(RETURN  ( FGREATERP  5.0  (LANERANGE  (CAAR  MLANE) 

(CADAR  MLANE) 

(CAAR  X) 

(CADAR  X) 

(CAR  Y) 

(CADR  Y]) 

[177] 


(*  edited: 

"  6-Aug-79  19:28") 

(*  This  function  returns  true  if  the  centroid  of  the 
position  is  interior  to  the  polygon.) 


(APPLY  (FUNCTION  INTERIOR) 

(APPEND  (CENTROID  POS) 
(CONS  STORM]) 


(INSIDE 

[LAMBDA  (POS  STORM) 
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[178] 


(GETATTB 

[LAMBDA  (REL  NODE)  (*  edited: 

"26-Jul-79  18:22") 

(PROG  [(SPEC  (QUOTE  (SIGHTING  *  SIGHTING3] 

(R PL AC A  SPEC  REL) 

(R PL AC A  (CDR  SPEC) 

(QUOTE  *)) 

(RPLACA  (CDDR  SPEC) 

NODE) 

(RETURN  (CADR  (GETUPLE  (CAR  ( STRIPSTREAM  (GETSH  SPEC!) 


(1791 


(GREATER- THAN 
[LAMBDA  (Q1  Q2) 

(GREATERP  Q1  Q21) 


(*  edited:  I 

"25-JU1-79  13:55")  I 


[1801 


(LESS-THAN 

[LAMBDA  (Q1  Q2) 

(GREATERP  Q2  Qll) 


(*  edited: 
"25-Jul-79  13:56") 


[1811 


(BEARING 

[LAMBDA  (SITE)  (*  edited: 

"  6-Aug-79  20:13") 

(*  Bearing  accepts  a  sighting  node  and  returns  the 
bearing  from  the  ownship  to  the  sighted  platform.) 


(PROG  (POS1  POS2  TIME) 

(SETQ  TIME  (GETATT  (QUOTE  TOS) 

SITE) ) 

(SETQ  POS1  (OWNPOS  TIME)) 

(SETQ  POS2  (CENTROID  (GETATT  (QUOTE  POSITION) 

SITE) ) ) _ 

(RETURN  (DIRECTION  (CAR  POS1) 

(CADR  POS1)  \ 

(CAR  POS2) 

(CADR  POS21) 


( cpppn 

[LAMBDA  (SITE) 


[182] 


(*  edited: 

"  7 -Aug-79  12:49") 


(*  Speed  accepts  a  sighting  node  and  computes  an 
estimated  speed  using  the  closer  of  the  predecessor 
or  successor.) 
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(PROG  (PRED  SUC  TPRED  TSUC  PPRED  PSUC  POS  TIME) 

(SETQ  TIME  (GETATT  (QUOTE  TOS) 

SITE) ) 

(SETQ  POS  (CENTROID  (GETATT  (QUOTE  POSITION) 

SITE) ) ) 

(SETQ  PRED  (PREDECESSOR  SITE)) 

(SETQ  SUC  (SUCCESSOR  SITE)) 

ICOND 

(SUC  (SETQ  TSUC  (GETATT  (QUOTE  TOS) 

SUC)) 

(SETQ  PSUC  (CENTROID  (GETATT  (QUOTE  POSITION) 

SUC) 

[COND 

(PRED  (SETQ  TPRED  (GETATT  (QUOTE  TOS) 

PRED) ) 

(SETQ  PPRED  (CENTROID  (GETATT  (QUOTE  POSITION) 

PRED] 

(COND 

((AND  (NULL  PRED) 

(NULL  SUC) 

(RETURN) ) ) 

[(NULL  PRED) 

(RETURN  (SPEEDM  TIME  TSUC  (DISTANCE  (CAR  POS) 

(CADR  POS) 

(CAR  PSUC) 

(CADR  PSUC] 

[(NULL  SUC) 

(RETURN  (SPEEDM  TPRED  TIME  (DISTANCE  (CAR  PPRED) 

(CADR  PPRED) 

(CAR  POS) 

(CADR  POS] 

[ (LESSP  (FDIFFERENCE  TIME  TPRED) 

(FDIFFERENCE  TSUC  TIME)) 

(RETURN  (SPEEDM  TPRED  TIME  (DISTANCE  (CAR  PPRED) 

(CADR  PPRED) 

(CAR  POS)  I 

(CADR  POS)  I 

(T  (RETURN  (SPEEDM  TIME  TSUC  (DISTANCE  (CAR  POS) 

(CADR  POS) 

(CAR  PSUC) 

(CADR  PSUC]) 

[1831 

(INTERIOR 

[LAMBDA  (OLAT  OLON  POLYGON)  (*  edited: 

"30-Jul-79  10:54") 

(*  This  function  determines  whether  the  point 
(OLAT  OLON)  is  inside  a  polygon. 

The  value  of  POLYGON  must  be  a  list  of  the  vertices 
in  either  clockwise  or  counter-clockwise 
(starting  anywhere)  order.  Each  vertex  is 
represented  by  a  two  element  list  containing  the 
latitude  and  longitude.) 
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(PROG  ((SUM  0.0) 

(POS1  (POLYGON: -1) ) ) 

(SETN  SUM  0.0)  (*  Must  reinitialize  SUM 


because  o£  SETNs) 


(for  POS  in  POLYGON 

do  (PROG  ((LAT  (POSsl) ) 

(LON  (POS: 2) ) 

(LAT1  (POSl : 1) ) 

(LON1  (POSl: 2)) 

(INC  0.0)) 

(SETN  INC  ((DIRECTION  OLAT  OLON  LAT  LON) 
-(DIRECTION  OLAT  OLON  LAT1  LONl))) 
(if  INC  LT  -180 

then  (SETN  INC  (INC+360)) 
elSeif  INC  GT  180 

then  (SETN  INC  (INC-360))) 

(SETN  SUM  ( SUM+INC) ) 

(POSl_POS) ) ) 

(RETURN  ((ABS  SUM) 

GT  1801) 


I 


(1841 


(DISTANCE 

[LAMBDA  (LAT1  LONl  LAT2  LON2) 

(FTIMES  60  (SUBTEND  LAT1  LONl  LAT2  LON2 ] ) 


[185] 


(DISTOLINE 

[LAMBDA  (X  Y  XI  Y1  X2  Y2)  (*  edited: 

"19-JU1-79  17:22") 

(*  Computes  the  distance  from  a  given  point  to  a 
line  segment  between  two  given  points) 


(PROG 


((A  1.369063E34) 

(B  1.369063E34) 

(C  1.369063E34) 

(COS1  0.0) 

(COS2  0.0)) 

(SETN  A  (DISTANCE  X  Y  XI  Yl)) 

(SETN  B  (DISTANCE  X  Y  X2  Y2)  ) 

(SETN  C  (DISTANCE  XI  Yl  X2  Y2) ) 

(SETN  COS1  (FDIFFERENCE  (FPLUS  (FTIMES  A  A) 

(FTIMES  C  C)) 
(FTIMES  B  B) ) / (2*A*C) ) 
(SETN  COS2  (FDIFFERENCE  (FPLUS  (FTIMES  B  B) 

(FTIMES  C  C)) 
(FTIMES  A  A) ) / (2*B*C) ) 


(RETURN  (COND 

((OR  (MINUSP  COS1) 
(MINUSP  COS2 ) ) 
(MIN  A  B) ) 
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(T  (PTIMES  A  (SIN  (ARCCOS  (MIN  1  COS11) 


[1861 


(INLANE 

[LAMBDA  (X  Y  LANE)  (*  NOBIND 

"15-Dec-78  14:06") 


(PROG  ((XI  68.39) 

( Y1  -16.57) 

(X2  68.39) 

(Y2  -16.57)) 

(SETN  XI  LANE: 1:1) 

(SETN  Y1  LANE: 1:2) 

(if  [SOME  LANE: : 1 

(FUNCTION  (LAMBDA  (LANEPOINT) 


(SETN  X2  LANEPOINT: 1) 
(SETN  Y2  LANEPOINT: 2)  * 


(PROG1  (LESSP  (DISTOLINE  X  Y  Xl  Y1  X2  Y2) 
MERCHANTLANEWIDTH) 

(SETN  XI  X2) 

(SETN  Y1  Y2] 

then  (RETURN  T] ) 


11871 


(LINPOLY 

[LAMBDA  (PT1  PT2  POLY)  (*  Checks  if  any  part  of 

line  segment  is  in 
polygon) 

(OR  (CROSSBOUNDARY  PT1  PT2  POLY) 

(INTERIOR  PT1 : 1  PT1:2  POLY] ) 

[188] 

(CROSSBOUNDARY 

[LAMBDA  (PT1  PT2  POLY)  (*  Determines  whether 

line  from  PT1  to  PT2 
crosses  the  boundary  of 
POLY) 

(SOMELINESEG  POLY  (FUNCTION  (LAMBDA  (PT3  PT4) 

(CROSSLINES  PT1  PT2  PT3  PT4] ) 


[189] 


(SOMELINESEG 

[LAMBDA  ( SOMEL INESEGX  SOMELINESEGFN) 

(*  This  is  an  analogue  of  SOME  that  treats  a  list  of 
points  (coord  pairs)  as  a  list  of  line  segments  and 
returns  T  if  SOMELINESEGFN  is  satisfied  by  one  of 
the  line  segments.  SOMELINESEGFN  must  be  a  function 
of  two  variables  for  the  two  points  of  the  line 
segment) 


(PROG  ( ( SOMEL INESEGPT1  (SOMELINESEGX: 1) ) ) 

(if  [SOME  SOMELINESEGX::!  (FUNCTION  (LAMBDA  ( SOMEL INESEGPT2) 
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(PROG1  (APPLY*  SOMELINESEGFN  SOMELINESEGPT1 
SOMELINESEGPT2) 

SOMELINESEGPTl_SOMELINESEGPT2] 

then  (RETURN  T] ) 


[190] 


(TRACKINPOLY 

(LAMBDA  (TRACK  POLY)  (*  Determines  if  a  track 

intersects  a  polygon) 

(SOMELINESEG  TRACK  (FUNCTION  (LAMBDA  (TRACKPT1  TRACK PT2 ) 

(LINPOLY  TRACKPT1  TRACKPT2  POLY]) 

[191] 

(CROSSLINES 

[LAMBDA  (A  B  P  Q) 

(*  The  lines  AB  and  PQ  cross  iff  A  and  B  are  on 
opposite  sides  of  PQ  and  P  and  Q  are  on  opposite 
sides  of  AB) 


(AND  (OPSIDES  A  B  P  Q) 
(OPSIDES  P  Q  A  Bl) 


[192] 


(OPSIDES 

[LAMBDA  (A  B  P  Q) 

(ROTSENSE  A  P  Q)=(ROTSENSE  Q  P  B] ) 


(*  Tests  if  A  and  B  are 
on  opposite  sides  of  PQ) 


I193J 

(ROTSENSE 

[LAMBDA  (ABC)  (*  edited: 

"30-Jul-7S  10:54") 

(*  Tests  if  the  minimal 
rotation  from  BA  to  BC 
is  clockwise) 

(PROG  [(ANGLE  ((DIRECTION  B:1  B:2  C:1  C:2)  I 

-(DIRECTION  B : 1  B:2  A:1  A:21  I 

(RETURN  (if  ANGLE  LT  -180.0 
then  T 

elgeif  ANGLE  GT  180.0 
then  NIL 

elseif  (MINUSP  ANGLE) 
then  NIL 
else  T] ) 


[1941 


(SUBTEND 

[LAMBDA  (LAT1  LONi  LAT2  LON2) 


(*  Gives  the  angle  at  the  center  of  the  earth 
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subtended  bi  the  two  points) 


(CGND 

( (EQP  LON1  LON2) 

(ABS  (FDIFFERENCE  LAT1  L AT2 ) ) ) 

(T  (PROG  KC1  (COS  (FPLUS  LAT1  LAT2 ) ) ) 

(C2  (COS  (FDIFFERENCE  LAT1  LAT2 ) ) ) 

(C3  (COS  (FDIFFERENCE  LON1  LON2] 

(RETURN  (ARCCOS  (FQUOTIENT  (FPLUS  (FTIMES  (FPLUS  Cl  C2) 

C3) 

C2 

(FMINUS  Cl)) 

2.0]) 

1195] 

(LANERANGE 

[LAMBDA  (ALAT  ALON  BLAT  BLON  CLAT  CLON) 

(PROG  ((CAT  (COS  ALAT)) 

(SAT  (SIN  ALAT)) 

(CAN  (COS  ALON)) 

(SAN  (SIN  ALON)) 

(CBT  (COS  BLAT)) 

(SBT  (SIN  BLAT)) 

(CBN  (COS  BLON)) 

(SBN  (SIN  BLON)) 

(CCT  (COS  CLAT)) 

(SCT  (SIN  CLAT)) 

(CCN  (COS  CLON) ) 

(SCN  (SIN  CLON)) 

( A1  0.0) 

(A2  0.0) 

(B1  0.0) 

(B2  0.0) 

(Cl  2 . 535301E30) 

(C2  0.0) 

A3  B3  C3) 

(SETN  A1  (FTIMES  CAT  CAN)) 

(SETN  B1  (FTIMES  CBT  CBN)) 

(SETN  Cl  (FTIMES  CCT  CCN)) 

(SETN  A2  (FTIMES  CAT  SAN)) 

(SETN  B2  (FTIMES  CBT  SBN)) 

(SETN  C2  (FTIMES  CCT  SCN)) 

(SETQ  A3  SAT) 

(SETQ  B3  SBT) 

(SETQ  C3  SCT) 

(RETURN 

(FTIMES 

60.0 

(ABS 

(FDIFFERENCE 

90.0 

(ARCCOS 

(FQUOTIENT 

[FPLUS  [FDIFFERENCE  (FTIMES  A1 

(FDIFFERENCE 
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(FTIMES  B2  C3) 
(FTIMES  B3  C2) ) ) 

(FTIMES  A2 

(FDIFFERENCE 
(FTIMES  B1  C3) 
(FTIMES  B3  Cl] 

(FTIMES  A3  (FDIFFERENCE  (FTIMES  B1  C2) 

(FTIMES  B2  Cll 

(SIN  (SUBTEND  ALAT  ALON  BLAT  BLON] ) 


[196] 


(WITHINR 

[NLAMBDA  L  (*  NOBIND 

"14-NOV-78  19:25") 

( NCONC  WITHINRFNS  L) 

(MAKEFILE  (QUOTE  WITHINR. LSP] ) 


[197] 


(CROSSPATHS 

[LAMBDA  (SI  S2  TI  T2) 


(*  edited: 
"26-Jul-79  12:11") 


(*  Tests  if  path  from  sightings  SI  to  S2  crosses 
that  from  Tl  to  T2) 


(PROG  ((PI  (CENTROID  SI) ) 

(P2  (CENTROID  S2) ) 

(Q1  (CENTROID  Tl) ) 

(Q2  (CENTROID  T2) ) ) 

(RETURN  (CROSSLINES  PI  P2  Q1  Q2]) 


[1981 


(LOCATION 
[LAMBDA  (S) 

(CENTROID  (GETATT  (QUOTE  POSITION) 

S]) 


(*  edited: 
"24-Jul-79  17:17") 


(1991 


(POSS-REPORT 

[LAMBDA  (SI  S2  PATROL)  (*  edited: 

"24-Jul-79  12:08") 


(PROG  (SUCCESSFLG  PL ATI ) 

(SETQ  PLAT1  (GETATTB  (QUOTE  SIGHTING) 

SI)  ) 

[MAPC  (GETATTB  (QUOTE  SOURCE) 

PATROL) 

(FUNCTION  (LAMBDA  (SNG) 

(PROG  NIL 

(PROG  ( (PLAT2  (GETATTB  (QUOTE  SIGHTING) 

SNG) ) ) 


(COND 
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(RETURN  SUCCESSFLG]) 


((NOT  (DISSIMILPLAT  PLAT1  PLAT2) ) 
(SETQ  SUCCESSFLG  T] 


I 

I 


[2001 


(DISSIMILPLAT 

[LAMBDA  (PL ATI  PLAT2 )  (*  edited: 

"19-JU1-79  17:28") 


(PROG  (SUCCESSFLG  VALl  VAL2) 

[MAPC  SHIPCHARS  (FUNCTION  (LAMBDA  (CHAR) 

(SETQ  VALl  (GETATT  CHAR  PL ATI) ) 

(SETQ  VAL2  (GETATT  CHAR  PLAT2) ) 

(AND  VALl  VAL2  (NOT  (EQUAL  VALl  VAL2 ) ) 
(SETQ  SUCCESSFLG  T] 

(RETURN  SUCCESSFLG]) 


I 

I 

I 


[201) 


(WENT-BEFORE 

[LAMBDA  (SI  T1  S2  T2  S3  T3  S4  T4> 


(*  edited: 

"30-Jul-79  10:56") 

(*  Tests  if  could  have 


gotten  from  SI  to  S2 
before  patrol 
overflight) 

(PROG  ((LI  (CENTROID  SI)) 

(L2  (CENTROID  S2) ) 

(L3  (CENTROID  S3)) 

(L4  (CENTROID  S4)) 

THETA  PHI  VM1  VM2  VP1  VP2  PSI  INITDIST  FINDIST  MINDIST 
MINTIME  P0  P4) 

(if  T2  It  T3 


then 


(*  Got  to  M2  before 


patrol  arrived  at  PI) 


(RETURN  T) ) 

(PHT. (DIRECTION  Ll:l  Ll:2  L2 : 1  L2:2)) 

(VMl.MAXSHIPSPEED* (COS  PHI)/60) 

(VM2_MAXSHIPSPEED* (SIN  PHI)/60) 

(VP1_(L3 : 1-L4 : 1) / (T3-T4) ) 

(VP2_(L3:2-L4:2) / (T3-T4) ) 

(P0_  <L3:1+(T1-T3)*VP1  L3 : 2+ (T1-T3) *VP2>) 

(P4_  <L3:l+(T2-T3)*VPl  L3 : 2+ (T2-T3) *VP2>) 

(*  Projected  positions 
of  patrol) 

( PS I_ ( ARCT AN  ( VM2 -VP2 ) / ( VM1 - VP1 ) ) ) 

(THETA_(ABS  PSI- (DIRECTION  LI : 1  LI : 2  P0:1  P0:2))) 

(if  THETA  gt  180 

then  THETA^( 360-THETA) ) 

(INITDIST. (DISTANCE  Ll : 1  LI: 2  P0:1  P0:2)) 

(FINDIST. (DISTANCE  L2 : 1  L2:2  P4:l  P4:2)) 

(if  THETA  gt  90  and  INITDIST  gt  PATROLRANGE 
then  (RETURN  T) ) 

(MINDIST.INITDIST* (SIN  THETA)) 

(MINTIME.(60*INITDIST* (COS  THETA) ) /MAXSHIPSPEED+T1) 

(if  MINDIST  gt  PATROLRANGE 
then  (RETURN  T) 


I 


I 


J 
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elseif  MINTIME  gt  T2  and  FINDIST  gt  PATROLRANGE 
then  (RETURN  T] ) 


[2021 


(WENT- AFTER 

[LAMBDA  (SI  TI  S2  T2  S3  T3  S4  T4) 


(*  edited: 

"30-Jul-79  10:55") 

(*  Tests  if  could  have 


(PROG 


gotten  from  SI  to  S2 
after  patrol  overflight) 

((LI  (CENTROID  SI)) 

(L2  (CENTROID  S2) ) 

(L3  (CENTROID  S3)) 

(L4  (CENTROID  S4) ) 

THETA  PHI  VM1  VM2  VPl  VP2  PSI  INITDIST  ENDDIST  MINDIST 
MINTIME  P0  P4) 

(if  Tl  gt  T4 

then  (*  Got  to  Ml  after 


patrol  arrived  at  P2) 


(RETURN  T) ) 

( PH I_( DIRECT ION  LI : 1  LI : 2  L2 : 1  L2:2)) 

(VM1_MAXSHIPSPEED* (COS  PHI)/60) 

(VM2_MAXSHIPSPEED* (SIN  PHI)/60) 

( VP1_ ( L3 : 1 -L4 : 1 ) / ( T3 -T4 ) ) 

( VP2_(L3 : 2-L4 : 2) / (T3-T4 ) ) 

(P0_  <L3 : 1+ (T1-T3) *VP1  L3 :2+ (T1-T3) *VP2>) 

(P4_  <L3 : 1+ (T2-T3) *VP1  L3 : 2+ (T2-T3) *VP2>) 

(*  Projected  positions 
of  patrol) 

( PS I_ ( ARCTAN  ( VM2 -VP2 ) / ( VM1 -VPl ) ) ) 

(THETA_(ABS  PSI- (DIRECTION  P4:l  P4:2  L2 : 1  L2:2))) 

(if  THETA  gt  180 

then  THETA_( 360-THETA) ) 

(INITDIST_(DISTANCE  LI : 1  LI: 2  P0:1  P0:2)) 

(ENDDIST_( DISTANCE  L2:l  L2:2  P4:l  P4:2)) 

(if  THETA  gt  90  and  ENDDIST  gt  PATROLRANGE 
then  (RETURN  T) ) 

(MINDIST_ENDDIST* (SIN  THETA)) 

(MINTIME_(-60*ENDDIST* (COS  THETA) ) /MAXSHIPSPEED+T2) 

(if  MINDIST  gt  PATROLRANGE 
then  (RETURN  T) 

elseif  MINTIME  It  Tl  and  INITDIST  gt  PATROLRANGE 
then  (RETURN  TJ) 


I 


[2031 


(LOC-TIME 
[LAMBDA  (S) 

(NCONC1  (CENTROID  (GETATT  (QUOTE  POSITION) 

S)  ) 

(GETATT  (QUOTE  TOS) 

S]> 


(*  edited: 
"24-Jul-79  17:51") 


I 
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( SWR 

[LAMBDA  (LT1  T1  LT2  T2)  (*  edited: 

"26-JU1-79  12:25") 

(*  Tests  if  sighting  SI  is  simply-within-reach  of 
S2,  ie.  by  travelling  straight  ahead  with  max  ship 
speed) 


(PROG  ((LI  (CENTROID  LT1))  I 

(L2  (CENTROID  LT2 ) ) )  I 

(RETURN  (LESSP  (S PE EDM  Tl  T2  (DISTANCE  (CAR  LI)  I 

(CADR  LI)  I 

(CAR  L2)  I 

(CADR  L2) ) )  I 

MAXSHIPSPEED1 ) 

[2051 

( SPEEDM 

[LAMBDA  (Tl  T2  DIST)  (*  edited: 

"  8-Aug-79  09:09") 

(ABS  (SPEEDAUX  (FQUOTIENT  Tl  60)  I 

(FQUOTIENT  T2  60)  I 

DIST]) 

[206] 

( GRAZ  E 

[LAMBDA  (SI  S2  Tl  T2)  (*  edited: 

"  6-Aug-79  20:03")  I 

(*  Given  two  sightings  of  each  of  two  platforms,  I 

graze  returns  true  if  the  paths  of  the  platforms  are  I 

within  the  patrolrange.  Time  is  not  considered.)  I 


(PROG  ((POS1  (CENTROID  SI)) 

(POS2  (CENTROID  S2)) 

(POS3  (CENTROID  Tl)) 

(POS4  (CENTROID  T2))) 

(RETURN  (OR  (LESSP  (DISTOLINE  (CAR  POS1) 

(CADR  POS1) 
(CAR  POS3) 
(CADR  POS3) 
(CAR  POS4) 
(CADR  POS4) ) 
PATROLRANGE) 

(LESSP  (DISTOLINE  (CAR  POS2) 

(CADR  POS2) 
(CAR  POS3) 
(CADR  POS3) 
(CAR  POS4) 
(CADR  POS4) ) 
PATROLRANGE] ) 
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[207] 


(SUCCESSOR 

[LAMBDA  (SITE) 


(*  edited: 

"  6-Aug-79  20:07") 


(*  Given  a  sighting  node  this  function  returns  the 
next  sighting  in  time  or  nil  if  there  is  no 
successor) 


(PROG  (SUCC  TOSX  TOSSUC  TOSSITE  PLAT) 

(SETQ  PLAT  (GETATTB  (QUOTE  SIGHTING) 

SITE) ) 

(SETQ  TOSSITE  (GETATT  (QUOTE  TOS) 

SITE) ) 

[for  X  in  (RETRIEVES  (QUOTE  SIGHTING) 

PLAT 

(QUOTE  *) 

3) 

do  (PROG  NIL 

(SETQ  TOSX  (GETATT  (QUOTE  TOS) 

X)) 


(COND 

( (LESSP  TOSSITE  TOSX) 

(COND 

((OR  (NULL  SUCC) 

(LESSP  TOSX  TOSSUC)) 
(SETQ  SUCC  X) 

(SETQ  TOSSUC  TOSX] 

(RETURN  SUCC]) 


[208] 


(PREDECESSOR 

[LAMBDA  (SITE)  (*  edited: 

"  6-Aug-79  20:09") 

(*  Given  a  sighting  node  this  function  returns  the 
previous  sighting  in  timef  or  nil  if  there  was  no 
previous  sighting.) 


(PROG  (PRED  TOSX  TOSPRED  TOSSITE  PLAT) 

(SETQ  PLAT  (GETATTB  (QUOTE  SIGHTING) 

SITE)) 

(SETQ  TOSSITE  (GETATT  (QUOTE  TOS) 

SITE)) 

[for  X  in  (RETRIEVES  (QUOTE  SIGHTING) 

PLAT 

(QUOTE  *) 

3) 

do  (PROG  NIL 

(SETQ  TOSX  (GETATT  (QUOTE  TOS) 

X)) 


(COND 
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( (LESSP  TOSX  TOSSITE) 

(COND 

((OR  (NULL  PRED) 

(LESSP  TOSPRED  TOSX) ) 
(SETQ  PRED  X) 

(SETQ  TOSPRED  TOSX I 


(RETURN  PRED] ) 


(DIRECTION  ..  .... 

(LAMBDA  (LAT1  LONl  LAT2  LON2)  (^edited: 

(PROG  ((PSI  0.0) 

(LONDIP  0.0) 

(BEARSIN  0.0) 

(BEARANGLE  0.0)) 

(SETN  PSI  (SUBTEND  LATl  LONl  LAT2  LON2)) 

(SETN  LONDIF  (FDIFFERENCE  LON2  LONl)) 

(COND 

( (EQP  LATl  90.0) 

(RETURN  180.0)) 

((EQP  LATl  -90.0) 

(RETURN  0.0))) 

(SETN  BEARSIN  (FQUOTIENT  (FTIMES  (COS  LAT2) 

(SIN  LONDIF)) 
(SIN  PSI))) 

(COND 

( ( FGTP  BEARSIN  1.0) 

(SETN  BEARSIN  1.0))) 

(COND 

((LESSP  BEARSIN  -1.0) 

(SETN  BEARSIN  -1.0))) 

(SETN  BEARANGLE  (ARCSIN  BEARSIN) ) 

(COND 

( (LESSP  LAT2  LATl) 

(SETN  BEARANGLE  (FDIFFERENCE  180.0  BEARANGLE] 
(COND 

( (MINUSP  BEARANGLE) 

(SETN  BEARANGLE  (FPLUS  360.0  BEARANGLE] 
(RETURN  BEARANGLE]) 


(2091 


(RANGE 

(LAMBDA  (SITE) 


(*  edited: 

"  6-Aug-79  20:15") 


(*  Range  accepts  a  sighting  node  and  computes  the 
distance  from  the  ownship  to  the  platform  sighted.) 


(PROG  (POS1  POS2  TIME) 

(SETQ  TIME  (GETATT  (QUOTE  TOS) 

SITE)) 

(SETQ  POS1  (OWNPOS  TIME)) 

(SETQ  POS2  (CENTROID  (GETATT  (QUOTE  POSITION) 
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SITE)))  '  I 

(RETURN  (DISTANCE  (CAR  P0S1)  I 

(CADR  POS1)  I 

(CAR  POS2)  I 

(CADR  POS2) ) 

[2111 

(COURSE 

[LAMBDA  (SITE)  (*  edited: 

"  7 -Aug-7 9  10:53") 

(*  Course  accepts  a  sighting  node  and  computes  an 

estimated  course.  To  do  this  the  closer 

(in  time)  of  the  predecessor  or  successor  is  used.) 


(PROG  (PRED  SUC  TPRED  TSUC  PPRED  PSUC  POS  TIME) 

(SETQ  TIME  (GETATT  (QUOTE  TOS) 

SITE) ) 

(SETQ  POS  (CENTROID  (GETATT  (QUOTE  POSITION) 

SITE) ) ) 

(SETQ  PRED  (PREDECESSOR  SITE)) 

(SETQ  SUC  (SUCCESSOR  SITE)) 

[COND 

(SUC  (SETQ  TSUC  (GETATT  (QUOTE  TOS) 

SUC)  ) 

(SETQ  PSUC  (CENTROID  (GETATT  (QUOTE  POSITION) 

SUCJ 

[COND 

(PRED  (SETQ  TPRED  (GETATT  (QUOTE  TOS) 

PRED) ) 

(SETQ  PPRED  (CENTROID  (GETATT  (QUOTE  POSITION) 

PRED] 

(COND 

((AND  (NULL  PRED) 

(NULL  SUC) 

(RETURN) ) ) 

[(NULL  PRED) 

(RETURN  (DIRECTION  (CAR  POS) 

(CADR  POS) 

(CAR  PSUC) 

(CADR  PSUC] 

[(NULL  SUC) 

(RETURN  (DIRECTION  (CAR  PPRED) 

(CADR  PPRED) 

(CAR  POS) 

(CADR  POS] 

[ (LESSP  (FDIFFERENCE  TIME  TPRED) 

(FDIFFERENCE  TSUC  TIME)) 

(RETURN  (DIRECTION  (CAR  PPRED) 

(CADR  PPRED) 

(CAR  POS)  I 

(CADR  POS]  I 

(T  (RETURN  (DIRECTION  (CAR  POS) 

(CADR  POS) 

(CAR  PSUC) 
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(CADR  PSUC]) 


[2121 


(SPEEDAUX 

[LAMBDA  (T1  T2  DIST) 

(FQUOTIENT  DIST  (FDIFFERENCE  T2  Til) 


(*  edited: 
"30-Jul-79  18:59") 


[213] 


(COURSEFROM 

[LAMBDA  (POS1  POS2) 

(SETQ  POS1  (CENTROID  POS1)) 
(SETQ  POS2  (CENTROID  POS2) ) 
(DIRECTION  (CAR  POS1) 

(CADR  POS1) 

(CAR  POS2) 

(CADR  POS2] ) 


(*  edited: 

"  7 -Aug-7 9  17:36") 


I 


[214] 

(SPEEDFROM 

[LAMBDA  (POS1  T1  POS2  T2)  (*  edited: 

"  7 -Aug-7 9  17:54") 

(SETQ  POS1  (CENTROID  POS1) ) 

(SETQ  POS2  (CENTROID  POS2) ) 

(SPEEDM  T1  T2  (DISTANCE  (CAR  POS1)  I 

(CADR  POS1)  I 

(CAR  POS2)  I 

(CADR  POS21) 

) 

(DECLARE:  DONTEVAL0LOAD  DOEVAL@COMPILE  DONTCOPY  COMPILERVARS 


(ADDTOVAR  NLAMA  WITHINR) 

(ADDTOVAR  NLAML  )  v 

(ADDTOVAR  LAMA  ) 

) 

(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (2459  25278  (SAME-AS  2471  .  2596)  ( 
ROUGHLY-THE-SAME-SPEED-AS  2600  .  3038)  (ROUGHLY-THE-SAME-COURSE-AS  3042 
.  3424)  (IN-LANE  3428  .  3958)  (INSIDE  3962  .  4322)  (GETATTB  4326  .  4652) 
(GREATER-THAN  4656  .  4794)  (LESS-THAN  4798  .  4933)  (BEARING  4937  .  5532 
)  (SPEED  5536  .  7000)  (INTERIOR  7004  .  8061)  (DISTANCE  8065  .  8154)  ( 
DISTOLINE  8158  .  8943)  (INLANE  8947  .  9441)  (LINPOLY  9445  .  9639)  ( 
CROSSBOUNDARY  9643  .  9892)  (SOMELINESEG  9896  .  10516)  (TRACKINPOLY  10520 
.  10739)  (CROSSLINES  10743  .  10962)  (OPSIDES  10966  .  11120)  (ROTSENSE 
11124  .  11616)  (SUBTEND  11620  .  12070)  (LANERANGE  12074  .  13253)  ( 
WITHINR  13257  .  13413)  (CROSSPATHS  13417  .  13807)  (LOCATION  13811  . 
13972)  (POSS-REPORT  13976  .  14572)  (DISSIMILPLAT  14576  .  14972)  ( 
WENT-BEFORE  14976  .  16560)  (WENT-AFTER  16564  .  18136)  (LOC-TIME  18140  . 
18348)  (SWR  18352  .  18841)  (SPEEDM  18845  .  19038)  (GRAZE  19042  .  19818) 
(SUCCESSOR  19822  .  20659)  (PREDECESSOR  20663  .  21518)  (DIRECTION  21522  . 
22474)  (RANGE  22478  .  23172)  (COURSE  23176  .  24559)  (SPEEDAUX  24563  . 
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24701)  (COURSEFROM  24705  .  24972)  (SPEEDFROM  24976  .  25275))))) 
STOP 
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changes  to:  PLATFNS  GETATT  ESTIMATE  NEAREST  ONEPOINT  CENTROID 
GETPOINT  FIXLONG 

previous  date:  "24-Jul-79  18:00:26"  <DKIBLER>PLAT.LSP.47) 


(PRETTYCOMPRINT  PLATCOMS) 


( RPAQQ  PLATCOMS  ( (FNS  *  PLATFNS))) 


(RPAQQ  PLATFNS  (GETATT  ESTIMATE  NEAREST  ONEPOINT  PLATPOS  PREDICTPOS 

SPAN  AUXINTERPOL  CENTROID  GETPOINT  FIXLONG)) 


(DEFINEQ 


I 


[2151 


(GETATT 

[LAMBDA  (REL  NAME)  (*  edited: 

"  6 -Aug-7 9  10:24") 

(*  This  function  accepts  a  two-argument  relation 
name  together  with  its  first  argument  and  returns 
the  first  instance  of  the  second  argument  which 
satisfies  the  relation.  It  is  useful  when  the 
relation  is  infact  a  function.) 


(PROG  [(SPEC  (QUOTE  (NIL  NIL  *] 

(RPLACA  SPEC  REL) 

(RPLACA  (CDR  SPEC) 

NAME) 

(RETURN  (CADDR  (GETUPLE  (CAR  (STRIPSTREAM  (GETSH  SPEC]) 


[2161 


(ESTIMATE 

[LAMBDA  (SITE1  SITE2  GAP)  (*  edited: 

"  6-Aug-79  10:33") 

(*  This  function  accepts  two  sightings  and  a 
normalized  time  factor  and  returns  an  estimated 
position.  The  estimated  position  may  be  in  the 
future  or  past,  and  will  be  a  polygon  if  either 
position  of  a  sighting  is  a  polygon. 

The  normalize  time  factor  is  the  desired  time  minus 
the  time  of  sightingl  divided  by  the  difference  in 
the  time  of  the  sightings.) 


(PROG1  [ MAPCAR  (SPAN  (GETATT  (QUOTE  POSITION) 

SITED 

(GETATT  (QUOTE  POSITION) 
SITE2) ) 

(FUNCTION  (LAMBDA  (X) 
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(AUXINTERPOL  (CAR  X) 

(CADR  X) 

GAP] 

(AND  EXPLAINFLAG  (PRIN1  "Estimated  from  the  sightings  ") 
(PRINl  SITED 
(PRIN1  "  and  ") 

(PRINl  SITE2) 

(TERPRIl ) 


12171 


(NEAREST 

[LAMBDA  (PT  LST)  (*  edited: 

"  6-Aug-79  10:40") 

(*  Given  a  point  P  and  a  list  of  points  L,  this 
function  returns  the  point  of  L  nearest  to  P. 

Each  point  is  a  latitude-longitude  pair.) 


(PROG  ((ANS  (CAR  LST)) 

Y  TEMP) 

(SETQ  TEMP  (DISTANCE  (CAR  PT) 

(CADR  PT) 
(CAR  ANS) 
(CADR  ANS))) 

[for  X  in  (CDR  LST)  do  (COND 


( (FLESSP  (SETQ  Y 

(DISTANCE  (CAR  PT) 
(CADR  PT) 
(CAR  X) 
(CADR  X))) 

TEMP) 

(SETQ  ANS  X) 

(SETQ  TEMP  Yl 

(RETURN  ANSI) 


[2181 


(ONEPOINT 

[LAMBDA  (NODE  GAP)  (*  edited: 

"  6-Aug-79  10:44") 

(*  Given  a  single  sighting  and  a  time  relative  to 
that  sighting,  this  function  generates  an  estimated 
position  which  will  be  a  polygon.) 


(PROG  ((X  (FTIMES  .5  GAP)) 

(POS  (GETATT  (QUOTE  POSITION) 

NODE) ) 

LAT  LONG) 

(AND  EXPLAINFLAG  (PRINl  "The  only  sighting  node  is  ") 
(PRINl  NODE) 

(PRINl 

"  and  no  course  was  known.  Hence  the  polygon  is  large.") 
(TERPRI) ) 
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(COND 

[(NULL  (CDR  POS)) 

(SETQ  LAT  (CAAR  POS)) 
(SETQ  LONG  (CADAR  POS)) 
(SETQ  X  (FTIMES  .5  GAP)) 


(*  .5  is  the  approximate  speed  in  degrees  of  a 
vessel.  (60  knots=l  degree  per  hour)) 


(RETURN  (LIST  (LIST  (FDIFFERENCE  LAT  X) 

(^DIFFERENCE  LONG  X)) 
(LIST  (FPLUS  LAT  X) 

(FDIFFERENCE  LONG  X)) 
(LIST  (FPLUS  LAT  X) 

(FPLUS  LONG  X)) 

(LIST  (FDIFFERENCE  LAT  X) 
(FPLUS  LONG  X] 

(T  (RETURN  (MAPCAR  (SPAN  (LIST  (CENTROID  POS)) 

POS) 

(FUNCTION  (LAMBDA  (Y) 

(AUXINTERPOL  (CAR  Y) 
(CADR  Y) 
X]) 


[219] 


(PLATPOS 

[LAMBDA  (PLAT  TIME)  (*  edited: 

"ll-Jul-79  13:10") 

(*  Given  a  platform  and  a  time  this  function  returns 
the  latitude  and  longitude  if  an  appropriate 
sighting  has  been  made.  If  there  are  bounding 
sightings,  a  position  is  estimated  by  interpolation. 

If  there  are  no  bounding  sightings,  a  polygon  is 
computed  by  extrapolation  and  returned.) 


(PROG  (X  Y) 

(SETQ  X  (MAPCAR  (RETRIEVER  (LIST  (QUOTE  SIGHTING) 

PLAT 

(QUOTE  *))) 

(FUNCTION  CDADR) ) ) 

(COND 

[[SETQ  Y  (SUBSET  X  (FUNCTION  (LAMBDA  (Z) 

(EQUAL  (GETATT  (QUOTE  TOS) 

Z) 

TIME] 

(AND  EXPLAINFLAG  (PRIN1 

"We  have  a  sighting  of  the  platform.") 

(TERPRI) ) 

(RETURN  (GETATT  (QUOTE  POSITION) 

(CAR  Yl 

(X  (RETURN  (PREDICTPOS  X  TIME))) 

(EXPLAINFLAG  (PRIN1  "No  sighting  of  platform  exists.") 


! 

\ 
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(TERPRI3 ) 


[2201 


(PREDICTPOS 

[LAMBDA  (NODELIST  TIME)  (*  edited: 

"ll-Jul-79  17:54") 

(*  This  function  distributes  the  task  of  computing 
an  approximate  position  depending  on  the  number  and 
type  of  sightings.) 


(PROG  (LB  UB  LBT  UBT  LB2  UB2  LBT2  UB2) 

[MAPC  NODELIST  (FUNCTION  (LAMBDA  (X) 

(PROG  (XT) 

( SETQ  XT  (GETATT  (QUOTE  TOS) 

X)) 


(COND 

[ (FLESSP  XT  TIME) 

(COND 

((OR  (NULL  LB) 

(FLESSP  LBT  XT)) 

(SETQ  LB2  LB) 

(SETQ  LBT2  LBT) 

(SETQ  LB  X) 

(SETQ  LBT  XT)) 

((OR  (NULL  LBT2) 

(FLESSP  LBT2  XT)) 

(SETQ  LBT2  XT) 

(SETQ  LB2  X) 

((COND 

((OR  (NULL  UB) 

(FLESSP  XT  UBT)) 

(SETQ  UB2  UB) 

(SETQ  UBT2  UBT) 

(SETQ  UB  X) 

(SETQ  UBT  XT)) 

((OR  (NULL  UBT2) 

(FLESSP  XT  UBT2) ) 

(SETQ  UBT2  XT) 

(SETQ  UB2  X))) 

(SETQ  UB  X) 

(SETQ  UBT  XT) 

(RETURN  (COND 

[ (AND  UB  LB) 

(ESTIMATE  LB  UB  (FQUOTIENT  (FDIFFERENCE  TIME  LBT) 

(FDIFFERENCE  UBT  LBT) 

[ UB2  (ESTIMATE  UB  UB2  (FQUOTIENT  (FDIFFERENCE 

TIME  UBT) 
(FDIFFERENCE 
UBT2  UBT) 

[LB2  (ESTIMATE  LB  LB 2  (FQUOTIENT  (FDIFFERENCE 

TIME  LBT) 
(FDIFFERENCE 
LBT  LBT2] 

(UB  (ONEPOINT  UB  (FDIFFERENCE  UBT  TIME))) 
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(LB  (ONEPOINT  LB  (PDIFPERENCE  TIME  LBTl) 


[221] 


(SPAN 

[LAMBDA  (LI  L2)  (*  edited: 

"ll-Jul-79  16:31") 

(*  This  function  takes  two  polygons 

(possibly  degenerate)  and  generates  an  approximation 
to  the  span  of  this  polygons.) 


(COND 

[ ( IGREATERP  (LENGTH  LI) 

(LENGTH  L2 ) ) 

(MAPCAR  LI  (FUNCTION  (LAMBDA  (X) 

(LIST  X  (NEAREST  X  L2) 
(T  (MAPCAR  L2  (FUNCTION  (LAMBDA  (X) 
(LIST  (NEAREST  X  LI) 
XI) 


12221 


(AUX INTERPOL 

[LAMBDA  (PT1  PT2  DELTA)  (*  edited: 

"16-Jul-79  18:33") 

(LIST  [FPLUS  (CAR  PT1) 

(FTIMES  DELTA  (FDIFFERENCE  (CAR  PT2) 

(CAR  PT1) 

(FIXLONG  (FPLUS  (CADR  PTl) 

(FTIMES  DELTA  (FIXLONG  (FDIFFERENCE 

(CADR  PT2) 

(CADR  PTl]) 


I 

I 


[223] 


(CENTROID 

[LAMBDA  (VERTEXLIST)  (*  edited: 

"  6-Aug-79  10:46") 

(*  Given  a  list  of  points,  which  are 
latitude-longitude  pairs,  this  function  returns  the 
centroid  of  those  points.) 


(PROG  ((Cl  (CAAR  VERTEXLIST)) 

(C2  (CADAR  VERTEXLIST)) 

(I  D) 

[COND 

((NULL  (CDR  VERTEXLIST)) 

(RETURN  (CAR  VERTEXLIST] 

LOOP (COND 

[(NULL  (CDR  VERTEXLIST)) 

(RETURN  (LIST  (FQUOTIENT  Cl  I) 
(FQUOTIENT  C2  I] 
(T  (SETQ  I  (ADD1  I)) 
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(SETQ  VERTEXLIST  (CDR  VERTEXLIST) ) 

(SETQ  Cl  (FPLUS  Cl  (CAAR  VERTEXLIST))) 
(SETQ  C2  (FPLUS  C2  (CADAR  VERTEXLIST))) 
(GO  LOOP]) 


(224] 


(GETPOINT 

[LAMBDA  (POS  BEAR  RANGE) 

(CLISP:  FLOATING)  (*  edited: 

"  6-Aug-79  10:58") 

(*  This  function  returns  the  new  position  reached  by 
traveling  from  the  given  position 

(a  latitude-longitude  pair)  at  the  given  bearing  for 
the  given  range.) 


(PROG  ((LAT  (POS: 1) ) 

(LONG  (POS: 2)) 

(PS I  (RANGE/60)) 

NEWLAT  NEWLONG  TMP  TMP2  SINLAT  COSPSI  COSLAT  SINPSI  COSBEAR 
COSNEWLAT) 

(SINLAT_(SIN  LAT)) 

(COSPSI_(COS  PSI)) 

( COSL AT_ ( COS  LAT)) 

(SINPSI_(SIN  PSI)) 

( COSB EAR_ ( COS  BEAR)) 

(NEWLAT_(ARCSIN  SINLAT*COSPSI+COSLAT*SINPSI*COSBEAR) ) 

(if  (EQUAL  90  (ABS  NEWLAT)) 
then  (RETURN  < NEWLAT  0>)) 

(COSNEWLAT. (COS  NEWLAT)) 

(TMP.SINPSI* (SIN  BEAR) /COSNEWLAT) 

( TMP2_ ( ARCCOS  (MAX  -1  (MIN  1  ( 

COSL AT*COSPS I-COSB  EAR*S INLAT*S INPS I ) 
/COSNEWLAT] 

( NEWLONG.LONG+ (if  TMP  gt  0 

then  TMP 2 
else  (-TMP2) ) ) 

( NEWLONG. (FIXLONG  NEWLONG)) 

(RETURN  <NEWLAT  NEWLONG>] ) 


(2251 


(FIXLONG 

[LAMBDA  (X)  (*  edited: 

"  6-Aug-79  11:01") 

(*  Given  a  longitude  whose  absolute  value  is  less 
than  360,  this  function  will  return  a  longitude  in 
the  proper  range.) 


(COND 

( (FLESSP  180  X) 

(FDIFFERENCE  X  360) ) 
((FLESSP  X  -180) 
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(FPLUS  X  360)) 

(T  XI) 

) 

(DECLARES  DONTCOPY 

(FILEMAP  (NIL  (422  10160  (GETATT  434  .  1065)  (ESTIMATE  1069  .  2031)  ( 
NEAREST  2035  .  2810)  (ONEPOINT  2814  .  4086)  (PLATPOS  4090  .  5041)  ( 
PREDICTPOS  5045  .  6582)  (SPAN  6586  .  7128)  (AUXINTERPOL  7132  .  7466)  ( 
CENTROID  7470  .  8252)  (GETPOINT  8256  .  9714)  (FIXLONG  9718  .  10157))))) 
STOP 


t 

? 
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(PILECREATED  "21-Aug-79  12:09:01"  <PMORRIS>QH.LSP.72  8186 
changes  to:  QHASK 

previous  date:  "  l-Aug-79  20:28:51"  <PMORRIS>QH.LSP.71) 


(PRETTYCOMPRINT  QHCOMS) 


(RPAQQ  QHCOMS  [(MACROS  QHGET  QHPUT) 

(FNS  *  QHPNS) 

(DECLARE:  DONTEVAL0LOAD  DOEVAL0COMPILE  DONTCOPY 
COMPILERVARS  (ADDVARS  (NLAMA  QHTAKE  PQ) 

(NLAML) 

(LAMA] ) 

(DECLARE:  EVAL0COMPILE 


(PUTPROPS  QHGET  MACRO  [(LOC  OFF) 

(GETHASH  (VAG  (IPLUS  (ITIMES  LOC  132) 

OFF  3] ) 


(PUTPROPS  QHPUT  MACRO  ((LOC  OFF  VAL) 

(PUTHASH  (VAG  (IPLUS 


) 


VAL))) 


(ITIMES 
OFF  3)) 


LOC  132) 


(RPAQQ  QHFNS  (PQ  QHCLEAR  QHMAKE  QHLIST  QHASK  BEEP  QHTAKE  QHFOLLOW 

QHPREP  QHSHOW) ) 


(DEFINEQ 


[226] 

(PQ 

[ NLAMBDA  L  (*  edited:  I 

"  l-Aug-79  13:26")  I 

(PROG  ( ( SYSPRETTYFLG  T) )  I 

(SHOWPRINT  (GETPP.OP  (CAR  L)  I 

(QUOTE  QHPRODS] ) 


[227] 


(QHCLEAR 

[LAMBDA  NIL  (*  edited: 

"15-Jun-79  18:44") 

(SETQ  QUERYHASHPTR  0)  I 

(CLRHASHJ ) 


[2281 


(QHMAKE 

[LAMBDA  (QHMAKEX  QHMAKEY  SHOWFLG) 

(PROG  ( (PTR  0) 

NEWPTR  CHARCODE) 

(COND 

( (LISTP  QHMAKEX) 


(*  edited: 
"27-Jul-79  18:33") 
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(QHLIST 

(LAMBDA 

(PROG 


[MAPC  QHMAKEX  (FUNCTION  (LAMBDA  (X) 

(QHMAKE  X  QHMAKEY  SHOWFLG] 

(RETURN) > 

((EQ  (NTHCHAR  QHMAKEX  1) 

(QUOTE  !)) 

(COND 

(SHOWFLG  (PR INI  (COND 

( (MEMB  (NTHCHAR  QHMAKEX  2) 

(QUOTE  (A  E  I  0  U))> 

"an  ") 

(T  "a  "))) 

(PRIN1  (SUBSTRING  QHMAKEX  2)) 

(TERPRI) ) 

(T  (QHMAKE  (EVAL  (MKATOM  (SUBSTRING  QHMAKEX  2))) 
QHMAKEY) ) ) 

(RETURN) ) ) 

(COND 

(SHOWFLG  (PRINT  QHMAKEX) 

(RETURN) ) ) 

IRPTQ  (NCHARS  QHMAKEX) 

(PROGN  [SETQ  CHARCODE  (CHCON1  (NTHCHAR  QHMAKEX 

(IMINUS  RPTN) 

(SETQ  NEWPTR  (QHGET  PTR  CHARCODE)) 

(COND 

(NEWPTR  (SETQ  PTR  NEWPTR)) 

(T  (QHPUT  PTR  CHARCODE  (SETQ  QUERYHASHPTR 
(ADD1  QUERYHASHPTR))) 

(QHPUT  PTR  0  (COND 

((QHGET  PTR  0) 

T) 

(T  CHARCODE))) 

(SETQ  PTR  QUERYHASHPTR] 

(QHPUT  PTR  -1  QHMAKEX) 

(QHPUT  PTR  -2  QHMAKEY]) 


[2291 


(PTR)  (*  edited: 

"20-Jun-79  15:32") 

( ITEM) 

(COND 

(PTR  (SETQ  ITEM  (QHGET  PTR  -1) ) 

[COND 

(ITEM  (COND  I 

((EQ  (NTHCHAR  ITEM  -1)  I 

(QUOTE  $))  I 

(*  Escape)  I 

(PRIN1  (SUBSTRING  ITEM  1-2))  I 

(PRIN1  "<anything>")  I 

(TERPRI))  I 

(T  (PRINT  ITEM]  I 

(COND 

((QHGET  PTR  0) 

(RPTQ  129  (QHLIST  (QHGET  PTR  (IDIFFERENCE  130  RPTN] 
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[230] 


(QHASK 

[LAMBDA  ( INBUF) 

(RESETLST 

(RESETSAVE  (CONTROL  T)  ) 

(RESETSAVE  (ECHOMODE)) 

(RESETSAVE  (RAISE  T) ) 

(RESETSAVE  ([LAMBDA  (X) 

(ECHOCONTROL  8  X] 

(QUOTE  REAL) ) ) 

(PROG  (PTR  BUFPTR  NEWPTR  CHAR  ITEM  CODE) 
(COND 

((EQ  (QHGET  0  0) 

63) 

(RETURN))) 


(*  edited: 
"21-Aug-79  12:08") 


(*  Nothing  except  query) 


ENTRY 

[COND 

((EQ  (PEEKC) 

(QUOTE  &)) 

(TERPRI) 

(RETURN  (CONS  (PRIN1  (RE ADC] 

(SETQ  PTR  0) 

(SETQ  BUFPTR  (CONS)) 

LOOP [OR  (QHGET  PTR  0) 

(RETURN  (CONS  (QHGET  PTR  -1) 

(QHGET  PTR  -21 
(SETQ  CHAR  (READC) ) 

(SETQ  CODE  (CHCON1  CHAR)) 

(SETQ  NEWPTR  (QHGET  PTR  CODE)) 

(COND 

(NEWPTR  (PRIN1  CHAR) 

(TCONC  BUFPTR  CHAR) 

(SETQ  PTR  NEWPTR)) 

[ (MEMB  CODE  (GETSYNTAX  (QUOTE  SEPRCHAR) ) ) 
(SETQ  ITEM  (QHGET  PTR  -1)) 

(COND 

[ITEM  (PRIN1  CHAR) 

(RETURN  (CONS  ITEM  (QHGET  PTR  -2) 
(T  (BEEP] 

((EQ  CODE  63) 

(*  Query) 

(TERPRI) 

( PRIN1  "one  of:") 

(TERPRI) 

(QHLIST  PTR) 

(TERPRI) 

(MAPRINT  INBUF) 

(PRIN1  "  ") 

(MAPC  (CAR  BUFPTR) 

(FUNCTION  PRIN1 ) ) ) 

((EQ  CODE  27) 

(*  Escape) 

(PROG  (NUM) 

(SETQ  NUM  (QHGET  PTR  0)) 
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INLOOP 

(COND 

((OR  (NOT  (NUMBERP  NUM) ) 

(QHGET  PTR  -1)) 

(COND 

(NUM  (BEEP))) 

(RETURN) )) 

(TCONC  BUFPTR  (PRINl  (CHARACTER  NUM))) 
(SETQ  PTR  (QHGET  PTR  NUM)) 

(SETQ  NUM  (QHGET  PTR  0)) 

(GO  INLOOP) )) 

((EQ  CODE  127) 


(*  Rubout) 


(TERPRI) 

(MAPRINT  INBUF) 

(PRINl  "  ") 

(GO  ENTRY)) 

[(AND  (SETQ  NEW PTR  (QHGET  PTR  27)) 

(SETQ  ITEM  (QHGET  NEWPTR  -1))) 

(RETURN  (CONS  [MKATOM  (CONCAT  (OR  (SUBSTRING  ITEM  1  -2) 

"  ■  ) 

(PRINl  CHAR) 

(RESETFORM  (ECHOMODE 
T) 

(READ) 

(QHGET  NEWPTR  -2] 

(T  (BEEP))) 

(GO  LOOP]) 


[2311 


(BEEP 

[LAMBDA  NIL 

(PRINl  (CHARACTER  7]) 


(*  edited: 
"15-Jun-79  13:24") 


(2321 


(QHTAKE 

[ NLAMBDA  L 

(QHFOLLOW  (CONS  L) 
(CONS] ) 


(*  edited: 
"12-Jul-79  19:25") 


[2331 


(QHFOLLOW 

[LAMBDA  (LL  BUFPTR  QHMATCH)  (*  edited: 

"  l-Aug-79  19:37") 


(PROG  (L  X  QHVAL  ALIST) 

START 

[COND 

( (CDR  LL) 

(SETQ  QHMATCH  (QHFOLLOW  (CDR  LL) 

BUFPTR  QHMATCH] 


(SETQ  L  (CAR  LL) ) 
LOOP (COND 
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((NULL  L) 

(RETURN  QHMATCH) ) )  (*  Default) 

(SETQ  X  (CAR  L)) 

(COND 

((EQ  X  (QUOTE  :)) 

(RETURN  (EVALA  (CADR  L) 

ALIST) ) ) 

((EQ  (CAR  X) 

(QUOTE  =)) 

(SETQ  ALIST  (CONS  (CONS  (CADR  X) 

QHMATCH) 

ALIST) ) 

(SETQ  L  (CDR  L)  ) 

(GO  LOOP)) 

( (STRINGP  X) 

[TCONC  BUFPTR  (PRIN1  (COND 

((EQ  (NTHCHAR  X  1) 

(QUOTE  -)) 

(CONCAT  (CHARACTER  8) 

(SUBSTRING  X  2))) 

(T  X] 

(PRINl  "  ") 

(SETQ  L  (CDR  L) ) 

(GO  LOOP))) 

(QHCLEAR) 

(QHPREP  (CAR  L) 

(CDR  L)) 

(QHMAKE  (QUOTE  ?) ) 

QUERY 

(SETQ  QHVAL  (QHASK  (CAR  BUFPTR))) 

(COND 

((EQ  (CAR  QHVAL) 

(QUOTE  ?)) 

(TERPRI) 

(PRINl  "one  of:") 

(TERPRI) 

(QHSHOW  L) 

(TERPRI) 

(MAPRINT  (CAR  BUFPTR) ) 

(PRINl  "  ") 

(GO  QUERY) ) 

((EQ  (CAR  QHVAL) 

(QUOTE  &)) 

(SETQ  QHVAR  (READ)) 

(CLEARBUF) 

(COND 

((NOT  (LISTP  ( EVALV  QHVAR))) 

(PRINl  "??")) 

(T  (TERPRI) 

(PRINl  "one  of") 

(TERPRI) 

(QHSHOW  (CONS  (EVAL  QHVAR) 

(TERPRI) 

(MAPRINT  (CAR  BUFPTR)) 

(PRINl  "  ") 

(GO  QUERY) ) ) 

(SETQ  QHMATCH  (CAR  QHVAL)) 
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(SETQ  LL  (REVERSE  (CDR  QHVAL) ) ) 
(PRIN1  "  ") 

(TCONC  BUFPTR  (CAR  QHVAL)) 

(GO  START]) 


[2341 


(QHPREP 

[LAMBDA  (FOCUS  QHLST  SHOWFLG  STK)  (*  edited: 


(COND 

[ (LISTP  FOCUS) 

(COND 

((EQ  (CAR  FOCUS) 

(QUOTE  “)) 

(QHPREP  (CDR  FOCUS) 

QHLST  SHOWFLG  STK) 
(QHPREP  (CAR  QHLST) 

(CDR  QHLST) 

SHOWFLG  STK) ) 


l-Aug-79  12:17") 


(T  (MAPC  FOCUS  (FUNCTION  (LAMBDA  (F) 

(QHPREP  F  QHLST  SHOWFLG  STK] 
[(AND  (EQ  (NTHCHAR  FOCUS  1) 

(QUOTE  <)) 

(EQ  (NTHCHAR  FOCUS  -1) 

(QUOTE  >))) 

(MAPC  (OR  (GETPROP  FOCUS  (QUOTE  QHPRODS) ) 

(HELP  "No  productions  for"  FOCUS)) 
(FUNCTION  (LAMBDA  (X) 

(QHPREP  (CAR  X) 

(CDR  X) 

SHOWFLG 

(CONS  QHLST  STK] 

(T  (QHMAKE  FOCUS  (CONS  QHLST  STK) 

SHOWFLG]) 


[235] 


(QHSHOW 

[LAMBDA  (L) 


(*  edited: 


(QHPREP  (CAR  L) 
(CDR  L) 
T]) 


"13-Jul-79  16:23") 

I 

I 


) 

(DECLARE:  DONTEVALiLOAD  DOEVAL8COMPILE  DONTCOPY  COMPILERVARS 


(ADDTOVAR  NLAMA  QHTAKE  PQ) 
(ADDTOVAR  NLAML  ) 


(ADDTOVAR  LAMA  ) 

) 

(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (727  8025  (PQ  739  .  965)  (QHCLEAR  969  .  1120)  (QHMAKE  1124 
.  2309)  (QHLIST  2313  .  2883)  (QHASK  2887  .  5007)  (BEEP  5011  .  5130)  ( 
QHTAKE  5134  .  5268)  (QHFOLLOW  5272  .  7119)  (QHPREP  7123  .  7851)  (QHSHOW 


<PMORRIS>QH.LSP.72 

7855  .  8022))))) 
STOP 


fc. 
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(PILECREATED  "27-Aug-79  21:39:40"  <RBECHTAL>RULES. . 29  16305 
changes  to:  (MATCH-PLAT  CONDITIONS) 

previous  date:  "27-Aug-79  18:40:58"  <RBECHTAL>RULES. . 28) 


(PRETTYCOMPRINT  RULESCOMS) 

( RPAQQ  RULESCOMS  ((VARS  *  RULESVARS) 

(FNS  *  RULESFNS) 

(PROP  (CONDITIONS  ACTIONS  CONF) 

*  PRODUCTIONS) ) ) 

(RPAQQ  RULESVARS  (PRODUCTIONS)) 

(RPAQQ  PRODUCTIONS  (INHERIT  NOT-LAST-SIGHTING  NOT-FIRST-SIGHTING 

FIRST- VIEW  NOT-KNOWN-COMBATANT  REACHABLE 
SIMPLY-REACHABLE  POSS-RPT  BLOCKER 
CREATEDETECT  CREATECONTACT  CREATEPLAT 
SMALL-CRAFT9  SMALL-CRAFT6  SMALL-CRAFT5 
SMALL-CRAFT4  SMALL-CRAFT3  SMALL-CRAFT2 
SMALL-CRAFTI  ID-LANE  INSIDE-A-STORM 
CLOSE-POPUP  DISTANT-POPUP  COURSE-CHANGED 
SPEED-CHANGED  FASTER-THAN-A-MERCHANT 
SLOWER-THAN-A-MERGHANT  MATCH-PLAT 
OUTS IDE- ALL- LANES) ) 

(RPAQQ  RULESFNS  (DEFINEPD  MAKEPD  FANCYPROD  LINEREAD) ) 

(DEFINEQ 

[2361 

(DEFINEPD 

[LAMBDA  NIL  (*  edited: 

"27-Jun-79  17:33") 

(PROG  (PDNAME  NEWCON  CONDS  NEWACT  ACT  CONFID)  I 

(*  DEFINEPD  provides  a  "nice"  user  interface  for  I 

production  rule  definition,  by  prompting  for  needed  I 

information.)  I 


(PRIN1  "NAME?  ") 

(SETQ  PDNAME  (CAR  (LINEREAD))) 

(PRIN1  "CONDITIONS?  ") 

DPDKCOND 

((SETQ  NEWCON  (LINEREAD)) 

(SETQ  CONDS  (APPEND  CONDS  NEWCON)) 
(GO  DPD1 ) ) ) 

(PRIN1  "ACTION?  ") 

DPD2 (COND 

((SETQ  NEWACT  (LINEREAD)) 

(SETQ  ACT  (APPEND  ACT  NEWACT)) 

(GO  DPD2) ) ) 

(PRIN1  "CONFIDENCE?  ") 
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(SETQ  CONFID  (CAR  (LINEREAD))) 

(MAKEPD  PDNAME  CONDS  ACT  CONFID]) 

1237] 


(MAKEPD 

[LAMBDA  (NAM  CO  AC  TRUST) 
(PROG  NIL 


(*  edited: 
"27-Jun-79  10:26") 


(*  MAKEPD  does  the  actual  construction  of 
productions.  The  elements  of  a  production  are  stored 
on  the  property  list  of  the  production  name.) 


(PUTPROP  NAM  (QUOTE  CONDITIONS)  I 

CO) 

(PUTPROP  NAM  (QUOTE  ACTIONS)  I 

AC) 

(PUTPROP  NAM  (QUOTE  CONF) 

TRUST) 

(SETQ  PRODUCTIONS  (CONS  NAM  PRODUCTIONS)) 

(RETURN  NAM1) 

[2381 

(FANCYPROD 

[LAMBDA  (PRO)  (*  edited: 

"27-Aug-79  17:18") 

(*  FANCYPROD  is  a 
prettyprinter  for 
productions. ) 

(PRIN1  "NAME:  ") 

(PRIN1  PRO) 

(TERPRI) 

(TERPRI) 

(PRIN1  "CONDITIONS:") 

(TERPRI) 

[PROG  [ (C  (GETPROP  PRO  (QUOTE  CONDITIONS] 

LOOOP 

(COND 

((NULL  C) 

(RETURN) ) 

(T  (SELECTQ  (CAAR  C) 

(♦UNLESS*  (PRETTYASSR  (CADAR  C) 

NIL  0.0) ) 

( *NOT*  (PRETTYASSR  (CADAR  C) 

NIL  -1.0)) 

[ *OR*  (PRINT  (QUOTE  *OR*) ) 

(MAPC  (CDAR  C) 

(FUNCTION  (LAMBDA  (X) 

(TAB  3) 

(PRETTYASSR  X] 

(PRETTYASSR  (CAR  C) ) ) 

(SETQ  C  (CDR  C)) 

(GO  LOOOPl 


(TERPRI) 
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(PRINl  "ACTION:") 

(TERPRI) 

[PROG  f(A  (GETPROP  PRO  (QUOTE  ACTIONS) 

ALP  (COND 

((NULL  A) 

(RETURN) ) 

(T  [COND 

[(EQ  (CAAR  A) 

(QUOTE  *OR*) ) 

(PRINl  "Either") 

(TERPRI) 

(MAPC  (CDAR  A) 

(FUNCTION  (LAMBDA  (CART) 

(TAB  5) 

(COND 

t (LISTP  (CAR  CART)) 

(PRETTYASSR  (CAR  CART)) 

(MAPC  (CDR  CART) 

(FUNCTION  (LAMBDA  (CARTEL) 
(PRINl  "  and  ") 
(PRETTYASSR  CARTEL) 

(T  (PRETTYASSR  CART) 

(T  (PRETTYASSR  (CAR  A) 

(SETQ  A  (CDR  A)) 

(GO  ALP) 

(TERPRI) 

(PRINl  "CONFIDENCE:  ") 

(PRINl  (GETPROP  PRO  (QUOTE  CONF) ) ) 

(TERPRI) 

(TERPRI) ) 


[239) 


(LINEREAD 

[LAMBDA  NIL  (*  NOBIND 

"22-Dec-78  12:27") 

(*  LINEREAD  reads  a  line,  terminated  by  a  CR,  right 
paren,  or  right  square  bracket. 

The  normal  LISP  READLINE  makes  some  inconvenient 
assuptions  about  typeahead,  which  this  doesn't.) 


(OR  (READP  T) 

(BKLINBUF  "  ")) 

(READLINE] ) 

) 

(RPAQQ  PRODUCTIONS  (INHERIT  NOT-LAST-SIGHTING  NOT-FIRST-SIGHTING 

FIRST-VIEW  NOT-KNOWN-COMBATANT  REACHABLE 
SIMPLY-REACHABLE  POSS-RPT  BLOCKER 
CREATEDETECT  CREATECONTACT  CREATEPLAT 
SMALL-CRAFT9  SMALL-CRAFT6  SMALL-CRAFT5 
SMALL-CRAFT4  SMALL- CRAFT3  SMALL-CRAFT2 
SMALL-CRAFTI  ID-LANE  INSIDE-A-STORM 
CLOSE-POPUP  DISTANT-POPUP  COURSE-CHANGED 
SPEED-CHANGED  FASTER-THAN-A-MERCHANT 
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SLOWER-THAN-A-MERCHANT  MATCH-PLAT 
OUTS IDE- ALL- LANES)  ) 

(PUTPROPS  INHERIT  CONDITIONS  ((ALIAS  *PLAT  *UNKNOWN) 

(TYPE  *PLAT  *TYP) 

(ID  *PLAT  *ID1) 

( ID-AMPLIFY  *PLAT  *IDMP) 

(CLASS  *PLAT  *CLS) 

(MEDIUM  *PLAT  *MED) ) ) 

(PUTPROPS  NOT-LAST-SIGHTING  CONDITIONS  ((SIGHTING  *PLAT  *S1) 

(SIGHTING  *PLAT  *S2) 

( *NOT*  (SAME- AS  *S1  *S2) ) 

(TOS  *S1  *T1 ) 

(TOS  *S2  *T2) 

(LESS-THAN  *T1  *T2) 

(♦UNLESS*  (NOT- LAST  *S1)))) 

(PUTPROPS  NOT-FIRST-SIGHTING  CONDITIONS  ((SIGHTING  *PLAT  *S1) 

(SIGHTING  *PLAT  *S2) 

( *NOT*  (SAME- AS  *S1  *S2)) 

(TOS  *S1  *T1) 

(TOS  *S2  *T2) 

(LESS-THAN  *T2  *T1) 

(♦UNLESS*  (NOT-FIRST  *S1 ) ) ) ) 

(PUTPROPS  FIRST-VIEW  CONDITIONS  ((SIGHTING  *PLAT  *S1) 

(♦UNLESS*  (NOT-FIRST  *S1) ) ) ) 

(PUTPROPS  NOT-KNOWN-COMBATANT  CONDITIONS  ((CONTACT  *CONT) 

(SIGHTING  *CONT  *S1) 

(♦UNLESS*  (WITHIN-REACH 
♦SI  *S2) ) 

(SIGHTING  *PLAT  *S2) 
(ID-AMPLIFY  *PLAT  MIL-BATTLE) 
(♦UNLESS*  (OWNSHIP  *PLAT) )  )  ) 

(PUTPROPS  REACHABLE  CONDITIONS  ((CONTACT  *GONT) 

(SIGHTING  *CONT  *S1) 

(SIGHTING  *PLAT  *S2) 

(♦NOT*  (SAME-AS  *PLAT  *CONT) ) 

(♦UNLESS*  (OWNSHIP  *PLAT) ) 
(SIMPLY-WITHIN-REACH  *S1  *S2) 

(♦UNLESS*  (BLOCKED-FROM  *S1  *S2)))) 

(PUTPROPS  SIMPLY-REACHABLE  CONDITIONS  ((CONTACT  *CONT) 

(SIGHTING  *CONT  *S1) 

(SIGHTING  *PLAT  *S2) 

(ID-AMPLIFY  *PLAT  MIL-BATTLE) 
(♦NOT*  (SAME-AS  *CONT  *PLAT) ) 
(♦UNLESS*  (OWNSHIP  *PLAT) ) 
(POSITION  *S1  *P1) 

(POSITION  *S2  *P2) 

(TOS  *S1  *T1) 

(TOS  *S2  *T2) 

( SWR  *P1  *T1  *P2  *T2) ) ) 
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(PUTPROPS  POSS-RPT  CONDITIONS  ((PATROL  *PTL) 

(CONTACT  *CONT) 

(SIGHTING  *CONT  *S1) 

(SIGHTING  *PLAT  *S2) 

( ID- AMPLIFY  *PLAT  MIL-BATTLE) 

( *UNLESS*  (OWNSHIP  *PLAT) ) 

(SOURCE  *S2  *PTL) 

( *NOT*  (SAME- AS  *S1  *S2) ) 

(♦UNLESS*  (DISSIMILAR  *CONT  *PLAT) ) ) ) 

(PUTPROPS  BLOCKER  CONDITIONS  ((CONTACT  *CONT) 

(SIGHTING  *CONT  *S1) 

(SIGHTING  *PLAT  *S2) 

( ID-AMPLIFY  *PLAT  MIL-BATTLE) 

( *NOT*  (SAME-AS  *CONT  *PLAT) ) 

(♦UNLESS*  (OWNSHIP  *PLAT) ) 

(PATROL  *PTL) 

(♦UNLESS*  (POSSIBLE-REPORT  *CONT  *PTL) ) 

(SIGHTING  *PTL  *S3) 

(NOT-LAST  *S3) 

(SUCCESSOR  *S3  *S4) 

(POSITION  *S1  *P1) 

(POSITION  *S2  *P2) 

(POSITION  *S3  *P3) 

(POSITION  *S4  *P4) 

(TOS  *S1  *T1) 

(TOS  *S2  *T2) 

(TOS  *S3  *T3) 

(TOS  *S4  *T4) 

(*OR*  (CROSSPATHS  *P1  *P2  *P3  *P4) 

(GRAZE  *P1  *P2  *P3  *P4) ) 

(♦NOT*  (WENT-BEFORE  *P1  *T1  *P2  *T2  *P3  *T3  *P4  *T4) ) 
(♦NOT*  (WENT-AFTER  *P1  *T1  *P2  *T2  *P3  *T3  *P4  *T4) ) ) ) 

(PUTPROPS  CREATEDETECT  CONDITIONS  ((SIGHTING  *PLAT  *SGT) 

(SOURCE  *SGT  EW) 

(♦UNLESS*  (DETECTION  *PLAT) ) ) ) 

(PUTPROPS  CREATECONTACT  CONDITIONS  ((SIGHTING  *PLAT  *SGT) 

(SOURCE  *SGT  RADAR) 

(♦UNLESS*  (CONTACT  *PLAT) ) ) ) 

(PUTPROPS  CREATEPLAT  CONDITIONS  ((SIGHTING  *PLAT  *SGT) 

(♦UNLESS*  (OWNSHIP  *PLAT) ) 

(♦UNLESS*  (PLATFORM  *PLAT) ) ) ) 

(PUTPROPS  SMALL-CRAFT9  CONDITIONS  ((CONTACT  *WHO) 

(FIRST-SIGHTING  *WHO  *S1) 

(SOURCE  *S1  RADAR) 

(RANGE  *S1  *R1) 

(LESS-THAN  *R1  8) 

(STRENGTH  *S1  STRONG))) 

(PUTPROPS  SMALL-CRAFT6  CONDITIONS  ((CONTACT  *X) 

(SIGHTING  *X  *SIGHT) 

(NOT-FIRST  *SIGHT) 

(RANGE  *SIGHT  *R) 
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(LESS-THAN  ‘R  16) 

(GREATER-THAN  ‘R  9) 

(STRENGTH  ‘SIGHT  WEAK) 

(SPEED  *SIGHT  *SPD) 

(‘UNLESS*  (GREATER-THAN  *SPD  20)))) 

(PUTPROPS  SMALL-CRAFT5  CONDITIONS  ( (CONTACT  *WHO) 

(SIGHTING  ‘WHO  *S1) 

(NOT-FIRST  *S1) 

(SOURCE  *S1  RADAR) 

(RANGE  *S1  * RANGE) 

(LESS-THAN  *RANGE  16) 

(GREATER-THAN  *RANGE  9) 

(STRENGTH  *S1  WEAK) 

(SPEED  *S1  *SPEED) 

(GREATER-THAN  *SPEED  20))) 

(PUTPROPS  SMALL-CRAFT4  CONDITIONS  ((CONTACT  ‘UNKNOWN) 

(SIGHTING  *UNKNOWN  *SIGHTING1) 
(LAND-DIST  *SIGHTING1  *DIST) 

(SOURCE  ‘SIGHTING1  RADAR) 

(RANGE  *SIGHTING1  ‘RANGE) 

(LESS-THAN  * RANGE  9) 

(GREATER-THAN  * RANGE  3) 

(STRENGTH  *SIGHTING1  WEAK) 

(LESS-THAN  *DIST  50))) 

(PUTPROPS  SMALL-CRAFT3  CONDITIONS  ((CONTACT  ‘UNKNOWN) 

(SIGHTING  *UNKNOWN  *SIGHTING) 
(LAND-DIST  ‘SIGHTING  *DIST) 

(SOURCE  ‘SIGHTING  RADAR) 

(RANGE  ‘SIGHTING  ‘RANGE) 

(LESS-THAN  ‘RANGE  9) 

(GREATER-THAN  ‘RANGE  3) 

(STRENGTH  ‘SIGHTING  WEAK) 
(GREATER-THAN  *DIST  50))) 

(PUTPROPS  SMALL-CRAFT2  CONDITIONS  ((CONTACT  ‘UNKNOWN) 

(SIGHTING  ‘UNKNOWN  ‘SIGHTING) 
(NOT-FIRST  ‘SIGHTING) 

(SOURCE  ‘SIGHTING  RADAR) 

(STRENGTH  ‘SIGHTING  WEAK) 

(SPEED  ‘SIGHTING  ‘SPEED) 

(‘UNLESS*  (GREATER-THAN  ‘SPEED  3)))) 

(PUTPROPS  SMALL-CRAFTI  CONDITIONS  ((CONTACT  ‘UNKNOWN) 

(SIGHTING  ‘UNKNOWN  ‘SIGHTING) 
(NOT-FIRST  ‘SIGHTING) 

(SOURCE  ‘SIGHTING  RADAR) 

(RANGE  ‘SIGHTING  ‘RANGE) 

(LESS-THAN  ‘RANGE  3) 

(STRENGTH  ‘SIGHTING  WEAK) 

(SPEED  ‘SIGHTING  ‘SPEED) 
(GREATER-THAN  ‘SPEED  3))) 

(PUTPROPS  ID-LANE  CONDITIONS  ((SIGHTING  ‘SHIP  ‘SIGHTING) 

(MERCHANTLANE  ‘LANE) 
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(PLATFORM  *SHIP) 

(LOCATION  ‘LANE  *LANELOC) 

(POSITION  ‘SIGHTING  *POS) 

(IN-LANE  ‘LANELOC  *POS) ) ) 

(PUTPROPS  INSIDE-A-STORM  CONDITIONS  ((SIGHTING  ‘SHIP  ‘SIGHTING) 

(PLATFORM  ‘SHIP) 

(STORM  ‘STORM) 

(POSITION  ‘SIGHTING  ‘POS) 

(LOCATION  ‘STORM  ‘STMLOC) 

(INSIDE  *POS  ‘STMLOC))) 

(PUTPROPS  CLOSE-POPUP  CONDITIONS  ((CONTACT  ‘SHIP) 

(FIRST-SIGHTING  ‘SHIP  ‘SIGHTING) 

(RANGE  ‘SIGHTING  ‘RANGE) 

(LESS-THAN  ‘RANGE  12))) 

(PUTPROPS  DISTANT-POPUP  CONDITIONS  ((CONTACT  ‘SHIP) 

(FIRST-SIGHTING  ‘SHIP  ‘SIGHTING) 
(RANGE  ‘SIGHTING  ‘RANGE) 
(GREATER-THAN  ‘RANGE  30))) 

(PUTPROPS  COURSE-CHANGED  CONDITIONS  ((CONTACT  ‘SHIP) 

(SIGHTING  ‘SHIP  ‘SIGHTING1) 
(NOT-FIRST  ‘SIGHTINGl) 

(NOT- LAST  ‘SIGHTINGl) 

(SUCCESSOR  ‘SIGHTINGl  ‘SIGHTING2) 
(COURSE  ‘SIGHTINGl  ‘COURSED 
(COURSE  ‘SIGHTING2  ‘COURSE2) 
(‘UNLESS*  ( 

ROUGHLY-THE-SAME-COURSE-AS  ‘COURSE1  ‘COURSE2) ) ) ) 

(PUTPROPS  SPEED-CHANGED  CONDITIONS  ((CONTACT  ‘SHIP) 

(SIGHTING  ‘SHIP  ‘SIGHTING) 

(NOT-FIRST  ‘SIGHTING) 

(NOT-LAST  ‘SIGHTING) 

(SUCCESSOR  ‘SIGHTING  ‘SIGHTING2) 
(SPEED  ‘SIGHTING  ‘SPEED1) 

(SPEED  ‘SIGHTING2  ‘SPEED2) 

(‘UNLESS*  (ROUGHLY-THE-SAME-SPEED-AS 
‘SPEED1  ‘SPEED2) ) ) ) 

(PUTPROPS  FASTER-THAN-A-MERCHANT  CONDITIONS  ((CONTACT  ‘SHIP) 

(SIGHTING  ‘SHIP  ‘SIGHTING) 
(NOT-FIRST  ‘SIGHTING) 

(SPEED  ‘SIGHTING  ‘SPEED) 
(GREATER-THAN  ‘SPEED  25))) 

(PUTPROPS  SLOWER-THAN-A-MERCHANT  CONDITIONS  ((CONTACT  ‘SHIP) 

(SIGHTING  ‘SHIP  ‘SIGHTING) 
(NOT-FIRST  ‘SIGHTING) 

(SPEED  ‘SIGHTING  ‘SPEED) 
(LESS-THAN  ‘SPEED  9))) 

(PUTPROPS  MATCH-PLAT  CONDITIONS  ((SIGHTING  * PL ATI  *SGT1) 

(NOT-FIRST  *SGT1) 

(SIGHTING  ‘PLAT2  *SGT2) 
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(♦NOT*  (SAME-AS  *PLAT1  *PLAT2) )  I 

(♦UNLESS*  (NOT-LAST  *SGT2)) 

(COURSE  *SGT1  *CRS1) 

(SPEED  *SGT1  *SPD1) 

(POSITION  *SGT1  *POSl) 

(TOS  *SGT1  *T1) 

(POSITION  *SGT2  *POS2) 

(TOS  *SGT2  *T2) 

(LESS-THAN  *T2  *T1) 

(COURSEFROM  *POS2  *POSl  *CRS2) 
(SPEEDFROM  *POS2  *T2  *POSl  *T1  *SPD2) 
(ROUGHLY-THE-SAM-COURSE-AS  *CRS1  *CRS2) 
(ROUGHLY-THE-SAME-SPEED-AS  *SPD1  *SPD2) 
)) 

(PUTPROPS  OUTS IDE-ALL- LANES  CONDITIONS  ((SIGHTING  *SHIP  ‘SIGHTING) 

(PLATFORM  *SHIP) 

(♦UNLESS*  (MEDIUM  ‘SHIP  AIR)) 
(♦UNLESS*  (INSIDE-A-MERCHANTLANE 
♦SIGHTING)))) 

(PUTPROPS  INHERIT  ACTIONS  ((TYPE  ‘UNKNOWN  *TYP) 

(ID  ‘UNKNOWN  *ID1) 

( ID-AMPLIFY  ‘UNKNOWN  *IDMP) 

(CLASS  ‘UNKNOWN  *CLS) 

(MEDIUM  ‘UNKNOWN  *KED) ) ) 

(PUTPROPS  NOT-LAST-SIGHTING  ACTIONS  ((NOT-LAST  *S1))) 

(PUTPROPS  NOT-FIRST-SIGHTING  ACTIONS  ((NOT-FIRST  *S1))) 

(PUTPROPS  FIRST-VIEW  ACTIONS  ((FIRST-SIGHTING  ‘PLAT  *S1) ) ) 

(PUTPROPS  NOT-KNOWN-COMBATANT  ACTIONS  ((TYPE  *CONT  MERCHANT))) 

(PUTPROPS  REACHABLE  ACTIONS  ( (WITHIN-REACH  *S1  *S2>)) 

(PUTPROPS  SIMPLY-REACHABLE  ACTIONS  ( (SIMPLY-WITHIN-REACH  *Sl  *S2))) 

(PUTPROPS  POSS-RPT  ACTIONS  ((POSSIBLE-REPORT  *CONT  *PTL) ) ) 

(PUTPROPS  BLOCKER  ACTIONS  ( (BLOCKED-FROM  *S1  *S2))) 

(PUTPROPS  CREATEDETECT  ACTIONS  ((DETECTION  ‘PLAT))) 

(PUTPROPS  CREATECONTACT  ACTIONS  ((CONTACT  ‘PLAT))) 

(PUTPROPS  CREATEPLAT  ACTIONS  ((PLATFORM  ‘PLAT))) 

(PUTPROPS  SMALL-CRAFT9  ACTIONS  ((TYPE  ‘WHO  SUB) 

(MODE  ‘WHO  SURFACE))) 

(PUTPROPS  SMALL-CRAFT6  ACTIONS  [(‘OR*  (TYPE  *X  FISHING) 

(TYPE  *X  PATROL) 

((TYPE  *X  SUB) 

(MODE  *X  SURFACE]) 
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(PUTPROPS  SMALL-CRAFT5  ACTIONS  ((‘OR*  (TYPE  ‘WHO  SUB) 

(TYPE  *WHO  PATROL)))) 

(PUTPROPS  SMALL-CRAFT4  ACTIONS  ((‘OR*  (TYPE  ‘UNKNOWN  SUB) 

(TYPE  ‘UNKNOWN  SHORE- PATROL) 

(TYPE  ‘UNKNOWN  PLEASURE) 

(TYPE  ‘UNKNOWN  COMMERCIAL) 

(TYPE  ‘UNKNOWN  LANDING)))) 

(PUTPROPS  SMALL-CRAFT3  ACTIONS  ((TYPE  ‘UNKNOWN  SUB))) 

(PUTPROPS  SMALL-CRAFT2  ACTIONS  ((‘OR*  (TYPE  ‘UNKNOWN  DEBRIS) 

(TYPE  ‘UNKNOWN  SUB) 

(TYPE  ‘UNKNOWN  BUOY)))) 

(PUTPROPS  SMALL-CRAFTI  ACTIONS  ((TYPE  ‘UNKNOWN  SUB) 

(‘OR*  (MODE  ‘UNKNOWN  PERISCOPE) 
(MODE  ‘UNKNOWN  SNORKEL)))) 

(PUTPROPS  ID-LANE  ACTIONS  ( ( INSIDE-A-MERCHANTLANE  ‘SIGHTING) 

(‘REPORT*  ‘SHIP 

"  was  sighted  in  the  merchant  lane  " 
‘LANE) ) ) 

(PUTPROPS  INSIDE-A-STORM  ACTIONS  ((TYPE  ‘SHIP  MERCHANT) 

(‘REPORT*  ‘SHIP 

"  was  sighted  inside  " 
♦STORM) ) ) 

(PUTPROPS  CLOSE-POPUP  ACTIONS  ((TYPE  ‘SHIP  MERCHANT))) 

(PUTPROPS  DISTANT-POPUP  ACTIONS  ((TYPE  ‘SHIP  MERCHANT))) 

(PUTPROPS  COURSE-CHANGED  ACTIONS  ((TYPE  ‘SHIP  MERCHANT))) 

(PUTPROPS  SPEED-CHANGED  ACTIONS  ((TYPE  ‘SHIP  MERCHANT))) 

(PUTPROPS  FASTER-THAN-A-MERCHANT  ACTIONS  ((TYPE  ‘SHIP  MERCHANT))) 
(PUTPROPS  SLOWER-THAN-A-MERCHANT  ACTIONS  ((TYPE  ‘SHIP  MERCHANT))) 
(PUTPROPS  MATCH-PLAT  ACTIONS  ((ALIAS  ‘PLAT2  *PLAT1))) 

(PUTPROPS  OUTS IDE- ALL- LANES  ACTIONS  ((TYPE  ‘SHIP  MERCHANT))) 
(PUTPROPS  INHERIT  CONF  1.0) 

(PUTPROPS  NOT-LAST-SIGHTING  CONF  1.0) 

(PUTPROPS  NOT-FIRST-SIGHTING  CONF  1.0) 

(PUTPROPS  FIRST-VIEW  CONF  .99) 

(PUTPROPS  NOT-KNOWN-COMBATANT  CONF  .45) 

(PUTPROPS  REACHABLE  CONF  .97) 
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(PUTPROPS 

POSS-RPT  CONF  .95) 

(PUTPROPS 

BLOCKER  CONF 

.9) 

(PUTPROPS 

CREATEDETECT 

CONF 

1.0) 

(PUTPROPS 

CREATECONTACT  CONF 

1.0) 

(PUTPROPS 

CREATEPLAT  CONF  1. 

0) 

(PUTPROPS 

SMALL-CRAFT9 

CONF 

.5) 

(PUTPROPS 

SMALL-CRAFT6 

CONF 

.15) 

(PUTPROPS 

SMALL-CRAFT5 

CONF 

.3) 

(PUTPROPS 

SMALL- CRAFT4 

CONF 

.1) 

(PUTPROPS 

SMALL- CRAFT3 

CONF 

.35) 

(PUTPROPS 

SMALL- CRAFT2 

CONF 

.12) 

(PUTPROPS 

SMALL-CRAFTI 

CONF 

.6) 

(PUTPROPS  ID-LANE  CONF  1.0) 

(PUTPROPS  INSIDE-A-STORM  CONF  -.25) 

(PUTPROPS  CLOSE- POPUP  CONF  -.2) 

(PUTPROPS  DISTANT-POPUP  CONF  -.2) 

(PUTPROPS  COURSE-CHANGED  CONF  -.3) 

(PUTPROPS  SPEED-CHANGED  CONF  -.3) 

(PUTPROPS  FASTER- THAN- A- MERCHANT  CONF  -.25) 

(PUTPROPS  SLOWER-THAN-A-MERCHANT  CONF  -.15) 

(PUTPROPS  MATCH- PLAT  CONF  .5) 

(PUTPROPS  OUTS IDE- ALL-LANES  CONF  -.08) 

(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (936  4519  (DEFINEPD  948  .  1975)  (MAKEPD  1979 
FANCYPROD  2513  .  4150)  (LINEREAD  4154  .  4516))))) 

STOP 


2509)  ( 


l 
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(FILECREATED  "  6-Aug-79  20:15:20"  <PMORRIS>STREAM.LSP.37  7631 


changes  to:  UNFREEZE 

previous  date:  "  6-Aug-79  14:19:01"  <PMORRIS>STREAM.LSP. 36) 


( PRETTYCOMPRINT  STREAMCOMS) 

(RPAQQ  STREAMCOMS  ( (FNS  *  STREAMFNS) 

(VARS  (MAPRETALIST  NIL) 

(FREEZEFLG  NIL) 

(FREEZELST  NIL)))) 

(RPAQQ  STREAMFNS  (ENDSTREAM  FREEZE  MAPSTREAM  NEWSTREAM  MAPRETRIEVE 

MAPRETDO  RETPULSEDO  RETRIEVES  PREPALIST 
RETSTREAM  GETMRVAL  SOMEPULSE  STRIPSTREAM 
PULSAR  PULSE  PUTSTREAM  UNFREEZE)) 

(DEFINEQ 

[2401 

(ENDSTREAM 

[LAMBDA  (S)  (*  edited: 

"  6-Aug-79  14:08") 

(*  This  has  an  effect  like  putting  an  end  marker  on 
a  stream.  It  actually  discards  the  suspensions  and 
replaces  them  by  the  marker  T,  which  informs 
MAPSTREAM  not  to  place  new  suspensions  on  the 
stream. ) 


( RPLACD  ST]) 


[2411 


(FREEZE 

[LAMBDA  NIL  (*  edited: 

"  3-Aug-79  17:32") 

(SETQ  FREEZEFLG  T) 

(QUOTE  Brr . . ] ) 


(2421 


(MAPSTREAM 

[LAMBDA  (MAPSTREAMX  MAPSTREAMINFO  MAPSTREAMFN) 

(*  edited: 

"  6-Aug-79  14:13") 

(PROG  NIL 

[MAPC  (CAAR  MAPSTREAMX) 

(FUNCTION  (LAMBDA  (X) 

(APPLY*  MAPSTREAMFN  X  MAPSTREAMINFO] 

(COND 

( (NEQ  (CDR  MAPSTREAMX) 

T) 
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(TCONC  (CDR  MAPSTREAMX) 

(CONS  MAPSTREAMINPO  MAPSTREAMFNJ ) 


(NEWSTREAM 
[LAMBDA  NIL 

(CONS  (CONS) 
(CONS)) 


(*  edited: 
"ll-Apr-79  17:09") 


(MAPRETRIEVE 

[LAMBDA  (MAPRETX  MAPRETINFO  MAPRETFN)  (*  edited: 

"  6-JU1-79  16:18") 


(MAPSTREAM  (RETSTREAM  MAPRETX) 

(CONS  (CONS  MAPRETALIST  MAPRETINFO) 
(CONS  MAPRETX  MAPRETFN) ) 
(FUNCTION  MAPRETDOJ) 


(MAPRETDO 

[LAMBDA  (SELT  AI) 

(SOMEPULSE  (GETPULSAR  SELT) 

(CONS  SELT  AI) 
(FUNCTION  RETPULSEDOl) 


(*  edited: 

"  6-JU1-79  16:23") 


(RETPULSEDO 

[LAMBDA  (SELTAI)  (*  edited: 

"  C-Jul-79  16:43") 


(PROG  ((SELT  (CAR  SELTAI)) 

(AI  (CDR  SELTAI)) 

ASS  MAPRETALIST  MAPRETINFO  MAPRETX  MAPRETFN) 

(DECLARE  (SPECVARS  MAPRETALIST)) 

(SETQ  ASS  (GETUPLE  SELT)) 

(SETQ  MAPRETALIST  (CAAR  AI)) 

(SETQ  MAPRETINFO  (CDAR  AI)) 

(SETQ  MAPRETX  (CADR  AI) ) 

(SETQ  MAPRETFN  (CDDR  AI) ) 

(SETQ  MAPRETALIST  (PREPALIST  MAPRETX  ASS  MAPRETALIST)) 
(RETURN  (APPLY*  MAPRETFN  SELT  MAPRETINFO]) 


( RETRIEVES 

[LAMBDA  (AT  OBJ  VAL  SEL)  (*  edited: 

"27-Jul-79  15:25") 

(PROG  ((SPEC  (QUOTE  (NIL  NIL  NIL))) 

ASS  ELT  ANS  LAST  ONEFLG  ASSES) 

(RPLACA  SPEC  AT) 

( RPLACA  (CDR  SPEC) 

OBJ) 


[243] 


[244] 


[245] 


[2461 


[247] 
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ICOND 

(VAL  (RPLACA  (CDDR  SPEC) 

VAL)  ) 

(T  (SETQ  LAST  (LAST  SPEC) ) 

(RPLACD  (CDR  SPEC] 

(OR  SEL  (SETQ  SEL  (COND 

((EQ  AT  (QUOTE  *) ) 

1) 

((EQ  OBJ  (QUOTE  *)) 

2) 

((EQ  VAL  (QUOTE  *) ) 

3) 

(T  2] 

(SETQ  ASSES  (STRIPSTREAM  (GETSH  SPEC))) 

(COND 

[ ( ILESSP  (for  X  in  SPEC  count  (EQ  X  (QUOTE  *))) 

2) 

(SETQ  ANS  (for  ASS  in  ASSES 

collect  (CAR  (NTH  (GETUPLE  ASS) 

SELl 

(T  (for  ASS  in  ASSES  do  (SETQ  ELT 

(CAR  (NTH  (GETUPLE  ASS) 
SEL)  ) ) 

(COND 

((NOT  (MEMBER  ELT  ANS)) 
(SETQ  ANS  (CONS  ELT  ANS] 

(OR  VAL  ( NCONC  SPEC  LAST)) 

(RETURN  ANS]) 


(2481 


(PREPALIST 

[LAMBDA  (CON  ASS  ALIST) 

(for  C  in  CON  as  A  in  ASS  do 


finally  (RETURN  ALIST]) 


(*  edited: 

"  6-Jul-79  17:55") 

(COND 

((AND  (VAR?  C) 

(NOT  (ASSOC  C  ALIST))) 
(SETQ  ALIST 

(CONS  (CONS  C  A) 

ALIST] 


(249] 


(RETSTREAM 

[LAMBDA  (C)  (*  edited: 

"29-Jun-79  15:44") 

(*  This  function  returns  the  stream  corresponding  to 
a  rule  condition.  It  constructs  a  specification  from 
the  conditionf  taking  into  account  the  variable 
bindings.  It  reuses  a  scratchlist 
(of  10  elements)  for  efficiency ,  chopping  off  the 
piece  that  it  doesn't  need.  After  the  stream  is 
obtained,  the  scratchlist  is  restored  to  full  size.) 


i 
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(PROG  ((SCRATCH  (QUOTE  (0000000000)))  I 

PTR  FOLLOW  S  XASSOC)  I 

(SETQ  PTR  SCRATCH) 

(MAPC  C  (FUNCTION  (LAMBDA  (X) 

(RPLACA  PTR  (COND 

[(VAR?  X) 

(SETQ  XASSOC  (ASSOC  X  MAPRETALIST) )  I 

(COND 

(XASSOC  (CDR  XASSOC))  I 

(T  (QUOTE  *] 

(T  X))) 

(SETQ  FOLLOW  PTR) 

(SETQ  PTR  (CDR  PTR] 

(RPLACD  FOLLOW  NIL) 

(SETQ  S  (GETSH  SCRATCH)) 

(RPLACD  FOLLOW  PTR) 

(RETURN  S]) 


[2501 


(GETMRVAL 

[LAMBDA  (X  COPYFLG) 

(SUBLIS  MAPRETALIST  X  COPYFLG]) 


(*  edited: 
"25-Jul-79  13:49") 


[251) 


(SOMEPULSE 

[LAMBDA  (PULSAR  PULSARDATA  SOMEPULSEFN)  (*  edited: 

"  5-Jul-79  19:06") 


(OR  (APPLY*  SOMEPULSEFN  PULSARDATA) 

( TCONC  PULSAR  (CONS  SOMEPULSEFN  PULSARDATA]) 


[252] 


( STRIPSTREAM 
[LAMBDA  (S) 

(CAAR  S]) 


(*  edited: 
"29-Jun-79  17:52") 


[2531 


(PULSAR 

[LAMBDA  NIL 

(CONS]) 


(*  edited: 

"  5-Jul-79  18:49") 


[2541 


(PULSE 

[LAMBDA  (PULSAR) 

(PROG  ((CELL  (CONSTANT  (CONS))) 

PTR) 

(SETQ  PTR  (RPLACD  CELL  (CAR  PULSAR))) 
LOOP (COND 

[(NULL  (CDR  PTR)) 


(*  edited: 

"  6-Jul-79  13:17") 
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(RPLACA  PULSAR  (CDR  CELL))  I 

(RPLACD  PULSAR  (COND  I 

((CAR  PTR)  I 

PTR]  I 

(T  (COND  l 

((APPLY*  (CAADR  PTR)  I 

(CDADR  PTR))  I 

(RPLACD  PTR  (CDDR  PTR)))  I 

(T  (SETQ  PTR  (CDR  PTR]  I 

(GO  LOOP]) 

[2551 

(PUTSTREAM 

[LAMBDA  (S  X)  (*  edited: 

"  6-Aug-79  14:18") 

(COND  1 

((EQ  (CDR  S)  I 

T)  I 

(HELP  "Can't  put  into  ended  stream  -  PUTSTREAM")))  I 

(TCONC  (CAR  S) 

X) 

(MAPC  (CADR  S) 

(FUNCTION  (LAMBDA  (SUSP) 

(COND 

(FREEZEFLG  (SETQ  FREEZELST  (CONS  (CONS  X  SUSP) 

(T  (APPLY*  (CDR  SUSP) 

X 

(CAR  SUSP]) 


(UNFREEZE 
[LAMBDA  NIL 

(SETQ  FREEZEFLG  NIL) 

[MAPC  (DREVERSE  FREEZELST) 

(FUNCTION  (LAMBDA  (XSUSP) 
(APPLY*  (CDDR  XSUSP) 
(CAR  XSUSP) 
(CADR  XSUSP] 
(SETQ  FREEZELST  NIL) 

(QUOTE  Ahh. . ] ) 


(RPAQ  MAPRETALIST  NIL) 

(RPAQ  FREEZEFLG  NIL) 

(RPAQ  FREEZELST  NIL) 

(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (526  7533  (ENDSTREAM  538  .  894)  (FREEZE  898  .  1036)  ( 
MAPSTREAM  1040  .  1535)  (NEWSTREAM  1539  .  1666)  (MAPRETRIEVE  1670  .  1913) 
(MAPRETDO  1917  .  2128)  (RETPULSEDO  2132  .  2803)  (RETRIEVES  2807  .  4155) 
(PREPALIST  4159  .  4526)  (RETSTREAM  4530  .  5535)  (GETMRVAL  5539  .  5681) 
(SOMEPULSE  5685  .  5870)  (STRIPSTREAM  5874  .  5988)  (PULSAR  5992  .  6099)  ( 


FREEZELST) ) ) 


[2561 


(*  edited: 

"  6-Aug-79  20:15") 

I 
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PULSE  6103  .  6750)  (PUTSTREAM  6754  .  7211)  (UNFREEZE  7215 
STOP 


7530))))) 
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(PILECREATED  "21-Aug-79  11:08:04"  <RBECHTAL>TOPLEVEL. .13  6972 
changes  to:  WELCOME 

previous  date:  "  9-Aug-79  13:23:33"  <RBECHTAL>TOPLEVEL. .12) 


(PRETTYCOMPRINT  TOPLEVELCOMS) 


( RPAQQ  TOPLEVELCOMS  ((VARS  *  TOPLEVELVARS) 

(FNS  *  TOPLEVELFNS) 

(P  (MINFS  512  2) ) ) ) 


(RPAQQ  TOPLEVELVARS  .(RESULTLIST  DUALFLG)  ) 
(RPAQQ  RESULTLIST  NIL) 

(RPAQQ  DUALFLG  NIL) 


( RPAQO  TOPLEVELFNS  (ADDIS  CKCONFIGURATION  EXLOOP  INCLUDEPLAT  PARTING 

STAMMER  STARTUP  STUFFLN  WAITER  WELCOME) ) 

(DEFINEQ 


[2571 


(ADDIS 

[LAMBDA  (SN)  (*  edited: 

"  6-Aug-79  13:44")  I 

(*  ATT IS  places  a  single 

sighting  of  a  platform  I 

into  the  display  file.) I 

(PROG  ( (PLT  (GETATTB  (QUOTE  SIGHTING)  I 

SN)  )  I 

(POS  (GETATT  (QUOTE  POSITION)  I 

SN)  )  I 

(TIM  (GETATT  (QUOTE  TOS)  I 

SN)  ) )  I 

(DISPLAY  PLT  (CAAR  POS) 

(CADAR  POS) 

TIM] ) 


(CKCONFIGURATION 

[2581 

[LAMBDA 

NIL 

(*  edited: 

(PROG 

NIL 

"31-JU1-79  16:23") 

(*  CKCONFIGURATION 

(COND 

( (TEKTEST) 

(DSPGRAB) 

(DSPINIT) 

(PRIN1  "Do  you  want  a  map?  ") 

determines  the  terminal 
configuration  and 
initializes  the  display 
routines. ) 
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(COND 

( (EQP  (CHCON1  (ASKOSER)) 

89) 

(DSPMAP) ) ) 

(CLEARBUF) 

(SETQ  DSPLAYFLG  T) 

(STARTUP))  I 

(T  (PRIN1  "Do  you  have  a  Tektronix  available  for  display?  ") 
(COND 

((EQP  (CHCON1  (ASKUSER)) 

89) 

(CLEARBUF) 

(SETQ  DUALFLG  T) 

(PRIN1  "What  is  the  Tek  terminal  number?  ") 

(OR  (DSPGRAB  (READ)) 

(HELP  "Failed  to  initialize  display  terminal:  " 
(DSPTTYSTR) ) > 

(CLEARBUF) 

(DSPINIT) 

(PRIN1  "Do  you  want  a  map?  ") 

(COND 

((EQP  (CHCON1  (ASKUSER)) 

89) 

(DSPMAP) )) 

(CLEARBUF) 

(SETQ  DSPLAYFLG  T) 

(STARTUP))  I 

(T  (CLEARBUF]) 


[2591 


(EXLOOP 

[LAMBDA  NIL  (*  edited: 

"  6-Aug-79  13:22") 

(*  EXLOOP  is  where  all  the  real  work  gets  done. 

MSGMTR  reads  messages  and  places  them  into  memory, 
and  returns  an  indication  of  what  should  be  done 
next.  Unless  MSGMTR  returns  NIL 
(out  of  messages)  or  IGNORE 

(uninteresting),  the  results  of  any  rule  firings  are 
printed,  and  the  explanation  system  is  called. 

Notice  that  with  the  stream  oriented  rule 

interpreter,  there  is  no  distinct 

"rule  interpretation"  cycle  or  function  call.) 


(PROG  (MSGFLG) 

EXLP (SETQ  MSGFLG  (MSGMTR)) 

(COND 

((EQ  MSGFLG  (QUOTE  IGNORE)) 
(GO  EXLP)) 

(MSGFLG  (RESOUT) 

(EXPLAIN) 

(GO  EXLP)) 

(T  (RETURN]) 
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[260] 


(INCLUDEPLAT 

[LAMBDA  (PNE)  (*  edited: 

"  6-Aug-79  13:24") 

(*  This  places  any  previously  existing  platform 
sightings  into  the  display  file. 

Used  for  initialization  for  "snapshot"  memories.) 


(MAPC  (RETRIEVES  (QUOTE  SIGHTING) 

PNE 

(QUOTE  *) 

3) 

(FUNCTION  ADDIS!) 

[261] 

(PARTING 

[LAMBDA  NIL  (*  edited: 

"  6-Aug-79  13:25")  I 

(*  PARTING  cleans  up  after  a  STAMMER  run.  I 

Kills  the  display  job  (if  any),  and  notifies  the  I 

user  of  the  end  of  run.)  I 


(PRIN1  "  Thank  you  for  your  interest  in  the  STAMMER  system.") 
(TERPRI) 

(COND 

(DSPLAYFLG  (FKKILL) 

(DSPRELD! ) 


[262] 


(STAMMER 

[LAMBDA  NIL  (*  edited: 

"  6-Aug-79  13:27") 

(*  This  is  it!  Start  rule  interpretation  by  doing  an 
APPLYRULE  to  all  the  rules,  greet  the  user,  do 
EXLOOP,  and  leave.  Simplicity  itself.) 


(MAPC  PRODUCTIONS  (FUNCTION  APPLYRULE)) 
( WELCOME) 

'  EXLOOP) 

PASTING) ) 


[263] 


•  » p 

(*  edited: 

"  6-Aug-79  13:35")  I 

I 

•  'TAP TUP  calls  functions  to  place  existing  I 
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platforms  and  merchantlanes  into  the  display  file, 
as  appropriate.  Particularly  oriented  for 
intermediate  memory  saves.) 


(MAPC  (RETRIEVES  (QUOTE  PLATFORM) 

"(QUOTE  *) 

NIL  2) 

(FUNCTION  INCLUDEPLAT) ) 

(MAPC  (RETRIEVES  (QUOTE  MERCHANTLANE) 

(QUOTE  *) 

NIL  2) 

(FUNCTION  STUFFLN] ) 

[2641 

(STUFFLN 

[LAMBDA  (MLN)  (*  edited: 

"  6-Aug-79  13:36")  I 

I 

(*  STUFFLN  places  all  of  the  locations  of  a  merchant  I 

lane  into  the  display  file.  Like  INCLUDEPLAT.)  I 


(DSPADDTRH  MLN  (QUOTE  ML) 

(QUOTE  XX)) 

(MAPC  (GETATT  (QUOTE  LOCATION) 

MLN) 

(FUNCTION  (LAMBDA  (VER) 

(DSPADDINC  MLN  (CAR  VER) 
(CADR  VER) 

o.on 


[2651 


(WAITER 

[LAMBDA  NIL  (*  NOBIND 

"22-Dec-78  16:33") 

(*  WAITER  is  used  to  introduce  a  user-controllable 
delay  in  single  terminal  display  mode.) 


(COND 

((NOT  DUALFLG) 

(TERPRI) 

(TERPRI) 

(TERPRI) 

(TERPRI) 

(TEKWAIT) 

(ASKUSER  5  (QUOTE  % 

"<CR>  to  continue,  <SPACE>  to  wait:" 
(QUOTE  (" 
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[266] 


NIL  (*  edited: 

"21-Aug-79  11:07") 

(*  WELCOME  is  the  "first"  thing  that  gets  done  when 
running  STAMMER.  (Actually,  the  rules  are 
intitialized  first.)  It's  a  good  place  to  put  any 
initialization  stuff.  Now,  it  is  used  to  allow  the 
user  to  select  a  message  file.) 


(NEWFL)  I 

(PRINl  "  Welcome  to  version  2  of  the  STAMMER  TSA  system.")  I 
(TERPRI)  I 

(PRINl  I 

"What  file  would  you  like  to  take  messages  from? 

(Default  is  ")  I 

(PRINl  MSGFILE)  I 

(PRINl  "):  ")  I 

(SETQ  NEWFL  (LINEREAD) )  I 

[COND  I 

((NULL  NEWFL))  I 

(T  (SETQ  MSGFILE  (CAR  NEWFL]  I 

(TERPRI)  I 

[MAPC  ASSERTIONS  (FUNCTION  (LAMBDA  (TB)  I 

(PUTPROP  TB  (QUOTE  TDB)  I 

T]  I 

(CKCONFIGURATION] ) 

) 

(MINFS  512  2) 

(DECLARE:  DONTCOPY 

(FILEMAP  (NIL  (516  6933  (ADDIS  528  .  1040)  (CKCONFIGURATION  1044  .  2141) 
(EXLOOP  2145  .  3082)  (INCLUDEPLAT  3086  .  3527)  (PARTING  3531  .  3987)  ( 
STAMMER  3991  .  4423)  (STARTUP  4427  .  5015)  (STUFFLN  5019  .  5493)  (WAITER 
5497  .  5877)  (WELCOME  5881  .  6930))))) 

STOP 


(WELCOME 

[LAMBDA 


(PROG 
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STAMMER  WELCOME  CKCONF IGURATION  TEKTEST  PRINCHAR 

I  I  DSPINIT  PKINIT  FKRACS 

II  II  FKJSYS  ASSEMBLE 

II  III  FKJSYSARG 

II  I  I  I  AC 

II  II  FKTTYSET  FKJSYS  (3 ) 

II  II  FKSW  FKJSYS  (3} 

II  II  FKHALT 

I  I  I  DSPQUIET  FKCALL  FKARRAYP  FKSHR 

II  III  NOFORK  FKINIT  {2> 

II  III  FKWAIT  FKJSYS  (3} 

II  III  FKIDPB 

II  III  FKCALL ERR 

II  III  PUTTYP 

II  III  FKSACS 

II  III  FKSW  (7} 

II  III  FKACSRETURN 

II  III  FKRACS 

II  III  FKHNDL 

II  III  FKHT 

II  III  FKACS 

II  III  FKSYM  FKSACS 

II  till  FKSW  (7> 

II  till  FKRACS 

II  I  I  I  I  FKHT 

II  I  I  I  I  NOFORK  UO} 

II  till  FKSYMACS 

II  till  FKHNDL 

II  I  I  I  I  GETRADIX50 

II  I  I  I  I  FKSYMPUT  {a> 

II  III  FKCATYPE 

II  III  FKSR  FKJSYS  (3} 

II  III  FKARRAYTYPE 

II  III  FKSHR 

II  III  FKRTN  ASSEMBLE 

II  II  FKJSYS  (3) 

I  I  I  BKDSPBUF  FKJSYS  (3> 

I  I  I  DSPCNVRT  CRUNCH 

I  I  I  FKSETVAL  NOFORK  1 10  > 

II  II  FKWAIT  {ID 

II  II  FKSACS 

II  II  FKSW  {7} 

II  II  FKACSRETURN 

II  II  FKHNDL 

II  II  FKHT 
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46. 

47. 

48. 

49. 

50. 

51. 

52. 

53. 

54. 

55. 

56. 

57. 

58. 

59. 

60. 
61. 
62. 

63. 

64. 

65. 

66. 

67. 

68. 

69. 

70. 

71. 

72. 

73. 

74. 

75. 

76. 

77. 

78. 

79. 

80. 
81. 
82. 

83. 

84. 

85. 

86. 

87. 

88. 

89. 

90. 


II  II  PKACS 

II  II  FKSYM  (22) 

II  II  FKIDPB 

I  I  I  FKCALL  (9> 

I  I  I  DSPTTY  FKCALL  (9) 

II  II  FKJSYS  (3J 

I  I  I  DSPTTYSTR  DECS AMEDIG ITS  tb} 

I  I  DSPMAP  FKSETVAL  (39) 

I  I  STARTUP  RETRIEVES  STRIPSTREAM 

II  II  GETSH  GETH  LOCH  (c) 

II  III  PUTH  NEWHASH  (d> 

II  II  II  LOCH  {c> 

II  III  NEWSTREAM 

II  II  GETUPLE 

I  I  I  INCLUDEPLAT  RETRIEVES  (54> 

II  II  ADDIS  DISPLAY  (e> 

II  II  GETATTB  {f> 

II  II  GETATT  (g> 

I  I  I  STUFFLN  DSPADDTRH  FKCALL  {9} 

If  I  I  DSPCNVRT  (38) 

I  I  I  GETATT  {g> 

I  I  I  DSPADDINC  FKCALL  €9> 

I  I  I  DSPCNVRT  (38> 

I  I  DSPGRAB  OCTSAMEDIGITS  OCTSAMEDIGITS  {69} 

I  I  I  FKJSYS  (3> 

I  I  DSPTTYSTR  (52) 

I  LINEREAD 

EXLOOP  RESOUT  RESULTPRINTER  GETUPLE 

I  I  PRETTYASSR  ASSRPRINT 

I  EXPLAIN  QHTAKE  QHFOLLOW  QHCLEAR 

I  I  I  QHPREP  QHPREP  {76 > 

III  I  QHMAKE  QHPUT 

III  I  QHMAKE  { 77  > 

III  I  QHGET 

I  I  '  I  QHMAKE  (77) 

I  I  I  QHSHOW  QHPREP  (76) 

I  I  I  QHFOLLOW  {75} 

I  I  I  QHASK  BEEP 

I  I  I  QHLIST  QHLIST  {84} 

III  I  QHGET 

I  I  I  QHGET 

I  I  RETRIEVES  {54} 

I  I  NEWVALOBJ  GETUPLE 

I  MSGMTR  BEYONDINTEREST 

I  INTERPOLABLE 
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91. 

92. 

93. 

94. 

95. 

96. 

97. 

98. 

99. 

100. 
101. 
102. 

103. 

104. 

105. 

106. 

107. 

108. 

109. 

110. 
111. 
112. 

113. 

114. 

115. 

116. 

117. 

118. 

119. 

120. 
121. 
122. 

123. 

124. 

125. 

126. 

127. 

128. 

129. 

130. 

131. 

132. 

133. 

134. 

135. 


FREEZE 

UNFREEZE  apply 

OWNMSG  CASSERT  SAVEPULSAR  PULSAR 

•  I  SERT  ADDH  PUTSH  PUTSTREAM  apply 

!  II  GETSH  {55} 

1  I  I  ENDSTREAM 

!  I  I  MATCHER 

•  I  I  BUMP 

1  I  I  GETSH  {55} 

1  I  GETSTRIP  STRIPSTREAM 

I  GETH  {55} 

I  DISPLAY  {e} 

I  NEWSYM 

DESCRIBEMSG  WAITER  TEKWAIT 
I  DSPCMD  FKCALL  {9} 

|  I  GRATEK  TEKCOM 

;  I  I  PRINCHAR 

1  I  MONTEK  TEKCOM 

I  CENTROID 

WEATHERMSG  CASSERT  {93} 

I  DSPADDTRH  {64} 

I  DSPADDINC  {67} 

SENSORMSG  CASSERT  {93} 

I  DISPLAY  {e} 

I  NEWSYM 

EWMSG  CASSERT  {93} 

DISPLOB  DISPLAY  {e} 

I  MIDP  TWO-PLACE 

NEWSYM 

GETPOINT  FIXLONG 

OWNPOS  PLATPOS  RETRIEVER  GETSTRIP  {100} 

I  RETVARS  VAR? 

I  GETUPLE 

I  VAR? 


APPLYRULE  SWEEPER  apply 
'  SWEEPER  {129} 


GETATT  {g} 

PREDICTPOS  GETATT  {g} 

ESTIMATE  {h} 
ONEPOINT  {i} 


ORHACK  SWEEPER  {129} 

NOTHACK  ORACLEHACK  VAR? 

*  *  apply 

J  I  CASSERT  {93} 

I  I  GETMRVAL 


i 


n,1T  lW»  -w-  !■ 
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56. 

57. 

58. 

59. 
10. 

11. 

12. 

13. 

14. 

15. 

16. 

17. 

18. 
19. 
>0. 

51. 

52. 

53. 

54. 

55. 

56. 

57. 

58. 

59. 

50. 

51. 

52. 

53. 

54. 

55. 

56. 

57. 

58. 

59. 

70. 

71. 

72. 

73. 

74. 

75. 

76. 

77. 

78. 

79. 

80. 


I  I  MAPRETRIEVE  MAPSTREAM  apply 

I  I  I  RETSTREAM  VAR? 

I  III  GETSH  (55) 

I  I  I  MAPRETDO  SOMEPULSE  apply 

I  I  I  GETPULSAR 

I  I  I  RETPULSEDO  { j) 

I  I  GETCON  GETMB  GETHARK 

I  III  BNEAS  MARKON 

I  III  BLFN  GBTMD  GETMARK 

I  III  II  DMEAS  { k ) 

I  III  I  GETCON  {142} 

I  III  I  GETMB  (142) 

I  III  DLFN  GETMB  (142) 

I  III  GETCON  {142> 

I  III  GETMD  {144} 

I  I  I  GETMD  {144} 

I  I  I  GETCON  {142} 

I  I  SWEEPER  {129} 

I  UNLESSHACK  ORACLEHACK  {132} 

!  I  CASSERT  {93} 

I  I  STRIPSTREAM 

I  I  RETSTREAM  {137} 

I  I  MASSAGE1  VAR? 

I  I  I  GETMRVAL 

I  I  MAPRETRIEVE  {136} 

I  I  GETCON  {142} 

I  I  SWEEPER  {129} 

I  ANDHACK  ORACLEHACK  {132} 

I  I  MAPRETRIEVE  {136} 

I  I  GETCON  {142} 

I  I  SWEEPER  {129} 

I  CONSTRUCT  ORBUILD  CONSTRUCT  {167} 

I  I  JUSTBUILD  SAVEPULSAR  {93} 

I  I  I  SBRT  {94} 

I  I  I  PULSE  apply 

I  I  I  MASSAGE1  {158} 

I  I  I  GETSTRIP  {100} 

I  I  I  GETPULSAR 

I  I  MAS SAG El  {158} 

I  GETMRVAL 

PARTING  FKKILL  FKJSYS  {3} 

I  FKHNDL 

I  FKPROG 

I  FKJFN 

I  FKDDT  NOFORK  {10} 
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181. 

182. 

183. 

184. 

185. 

186. 

187. 

188. 


FKDDT_ 
FKHNDL 
FKDDT  (180> 
FKJSYS  (3) 
FKSW  (7) 
FKTTYSET  (6 J 


I  FKSHR 

DSPRELD  FKJSYS  (3> 


189.FKSYMPUT  FKHT 


190 .DECSAMEDIGITS  DECS AMEDIG ITS  (190) 


191.  LOCH  PREHASH  PREHASH  {191} 

192.  NEXTH 


193. NEWHASH  CREATH 

194.  MAPH  apply 

195.  PUTH  (56) 


196.  DISPLAY  DISPCHECK 

197.  DSPADDTRH  {64} 

198.  DISPMARK 

199.  DSPADDINC  {67} 

200.  MELD 

201.  IDENT  RETRIEVER  {121} 

202.  I  GREATESTPROB  GETCON  {142} 

203.  MEDIUM  RETRIEVER  {121} 

204.  GREATESTPROB  {202} 


205. GETATTB  GETUPLE 

206.  STRIPSTREAM 

207.  GETSH  {55} 


208. GETATT  GETUPLE 

209.  STRIPSTREAM 

210.  GETSH  {55} 


214.0NEP0INT  GETATT  {208} 

215.  SPAN  {211} 

216 .  CENTROID 


overflow  -  a 
overflow  -  b 
overflow  -  c 


overflow  -  d 


overflow  -  e 


211.  ESTIMATE  SPAN  NEAREST  DISTANCE  SUBTEND 

212.  GETATT  {208} 

213 .  AUXINTERPOL  FIXLONG 


overflow  -  f  j 


overflow  -  g 


overflow  -  h 


overflow  -  i 
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3 


217.  AUXINTERPOL  {213 > 


218. RETPULSEDO  apply 

219.  GETUPLE 

220.  PREPALIST  VAR? 


221. DHEAS  MARKON 

222.  BLFN  <144) 

223.  DLFN  {148} 

Send (verbatim) 


overflow  -  j 


overflow  -  k 
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AODH [ ARGS, NEWVALl 
calls:  PUTSH 

called  by:  SERT 

ADDIS ISN] 

calls:  DISPLAY, GETATTB, GETATT 

called  by:  INCLUDEPLAT 
binds:  PLT,POS,TIM 

ANDH ACK [ CONDITIONS , ACT IONS , EV ] 

calls:  ORACLEHACK,MAPRETRIEVE, LIST, FUNCTION, GREATERP,GETCON, SWEEPER, 

CONS 

called  by:  SWEEPER 
binds:  P,X,CLIST 

APPLYRULElRULENAME, PREBIND] 

cal 1 s :  SWEEPER , SUBL IS , GETPROP , CONS 

called  by:  STAMMER 

ARRLOC [ARR] 

calls:  ARRAYP , FKARRAYP , IPLUS, LOC, ERROR 

ASSERT [ARGLIST, NODENAME] 

calls :  SET, SAVEPULSAR, SERT, GETSTRIP, GENSYM, CONS 

binds:  REPLY, LEN, A 

uses  free:  ASSERTIONS 

ASSRPRINTlPRINSPEC] 

calls :  STRINGP, NUMBERP, PRIN1 , NTH, EVAL, TERPRI 

called  by:  PRETTYASSR 

uses  free:  BODY , OVERCONF , LSTFLG 

AUXINTERPOL [ PT1 , PT2 , DELTA] 

calls :  LIST, FPLUS, FTIMES, FDIFFERENCE, FIXLONG 

called  by:  ESTIMATE, ONEPOINT 

BEARING [SITE! 

calls :  GETATT, OWNPOS, CENTROID, DIRECTION 

binds:  TIME,POSl,POS2 

BEEP [ J 

calls:  PRIN1, CHARACTER 

called  by:  QHASK 

BEYONDINTEREST [ TXT] 
called  by:  MSGMTR 


BKDSPBUFIX] 

calls:  MAPC,CHCON, FKJSYS 

called  by:  DSPINIT 

binds:  C 

uses  free:  DSPTTYCODE 

BLFNtBNODE] 

calls:  GREATERP , GETMD , GETCON , G  ETMB , MIN 

called  by:  BMEAS,DMEAS 

binds:  BNCON 

uses  free:  BMEASANS 

BMEAS  tBBOX] 

calls :  MINUSP, FGREATERP, RESETLST, GETPROP, RESETSAVE , MARKON, MAPC, BLFN, 

DLFN, FTIMES , FDIFFERENCE, FPLUS 
called  by:  GETMB 

binds :  BMEASANS, RULECON, BASTLST, DMEASANS 

uses  free:  BAST, MBCOMB 

BUMP [L] 

calls:  DREVERSE, CONS 

called  by:  SERT 
binds:  ANS 

CASSERT [ SPEC , VAL ] 

calls :  GREATERP, PUTPROP, SET, SAVEPULSAR, SERT, GETSTRIP, GENSYM, CONS, ABS 

called  by :  EWMSG , ORACL EH ACK , OWNMSG , S ENSORMSG , UNL ESSH ACK , WEATH ERMSG , DENY , 
MAYBE, STATE 
binds:  NEWNODE 

uses  free:  ASSERTIONS 

CENTRO I D [ VERTEXL 1ST ] 

calls:  LIST, FQUOTIENT, ADD1, FPLUS 

called  by:  BEARING, COURSE, COURSEFROM, CROSSPATHS, DESCRIBEMSG, GRAZE, IN-LANE, 
INSIDE, LOC-TIME, LOCATION, ONEPOINT, RANGE, SPEED, SPEEDFROM, SWR, 
WENT- AFTER, WENT-BEFORE 
binds:  I,C1,C2 

CHANG ECON [RLNME1 ] 

calls :  PRIN1 , PUTPROP, CLEARBUF, GETPROP, READ, TERPRI 

CKCONFIGURATION U 

calls :  TEKTEST, EQP, DSPINIT, PRIN1 , DSPMAP, CLEARBUF, STARTUP, HELP, CHCON1 , 

ASKUSER, DSPGRAB, READ, DSPTTYSTR 
called  by:  WELCOME 

uses  free:  DUALFLG, DSPLAYFLG 
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CONSTRUCT {ACTIONS , EV, COUNT 3 

calls :  ORBUILD, JUSTBUILD, CONS, MASSAGE1 

called  by:  ORBUILD, SWEEPER 
binds:  FIRST 


binds: 

L1S<* .<3  f  rpp! 


COURSE [SITE] 

calls:  LESSP, GETATT, CENTROID, PREDECESSOR , SUCCESSOR, DIRECTION, 

FDIFFERENCE 

binds :  TIME, POS, PRED, SUC, TSUC, PSUC, TPRED, PPRED 


COURSEFROM [ POS1 , POS2  3 

calls:  CENTROID, DIRECTION 


CREATHISIZE3 

calls:  ARRAY, ADD1, IQUOTIENT, LOG, ITIMES 

called  by:  NEWHASH 

uses  free:  MEMFULLSIZE,MEMFILLED, MEMFACTOR, MEMS I ZE, MEMORY 


CROSSBOUNDARY [ PT1 , PT2 , POLY] 

calls :  SOMELINESEG, FUNCTION, CROSSLINES 

called  by:  L INPOLY 
binds:  PT3,PT4 


CROSSLINES IA, B,P,Q3 
calls:  OPSIDES 

called  by:  CROSSPATHS, CROSSBOUNDARY 

CROSSPATHS [ SI , S2 , T1 , T2  3 

calls:  CENTROID, CROSSLINES 

binds:  P1,P2,Q1,Q2 

CRUNCH tX3 

calls:  RPTQ , SETN , LOGOR, LLSH 

called  by:  DSPCNVRT 
binds:  NUM,RPTN 

DECSAMEDIGITS [X3 

calls :  LESSP, I PLUS, IREMAINDER, ITIMES, DECSAMEDIGITS, IQUOTIENT 

called  by:  DECSAMEDIGITS, DSPTTYSTR 

DEFINEPDt  3 

calls :  PRINl , MAKEPD, LINEREAD, APPEND 

binds :  PDNAME , NEWCON, CONDS , NEW ACT, ACT, CONFID 
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DENYlL] 

calls:  CASSERT 

DESCRIBEMSG [TXT] 

calls :  NUMBERP, TERPRI , SPACES, PRIN1 , WAITER, DSPCMD, LAST, CENTROID, LIST 

called  by:  MSGMTR 

binds:  POS, TIME, WKNM, SOURCE 

uses  free:  OWNSHIP, CURTIME, DSPLAYFLG 

DIRECTION [ LAT1 , LON1 , LAT2 , LON2  J 

calls :  EQP, FGTP, LESSP,MINUSP, SETN, SUBTEND, FDIFFERENCE, FQUOTIENT, 

FTIMES, COS, SIN, ARCSIN, FPLUS 

called  by:  BEARING, COURSE, COURSEFROM, INTERIOR, ROTSENSE,WENT-AFTER, 
WENT-BEFORE 

binds:  PSI, LONDIF,BEARSIN, BEAR ANGLE 

DISPCH  ECK [ NAME ] 

calls:  GETPROP 

called  by:  DISPLAY 

DISPLAY [PLATNAME, LAT, LON, TIME] 

calls :  DISPCHECK, DSPADDTRH, DISPMARK, DSPADDINC, FLOAT, MELD, IDENT, MEDIUM 

called  by:  ADDIS, DISPLOB, OWNMSG, SENSORMSG 
uses  free:  DSPLAYFLG 

DISPLOB [ PNAME , SPOS , DPOS , TIME ] 
calls:  DISPLAY, MIDP 

called  by;  EWMSG 
binds:  TEMPI, TEMP2 

uses  free:  DSPLAYFLG 

DISPMARK [NAME] 

calls:  PUTPROP 

called  by:  DISPLAY 

DISSIMILPLATtPLATl , PLAT2 ] 

calls:  EQUAL, MAPC,GETATT 

called  by:  POSS-REPORT 
binds:  VAL1,VAL2,SUCCESSFLG,CHAR 

uses  free:  SHIPCHARS 

DISTANCE [ LAT1 , LON1 , LAT2 , LON2 ] 
calls:  FTIMES, SUBTEND 

called  by:  DISTOLINE, NEAREST, RANGE, SPEED, S PE EDFROM, SWR, WENT- AFTER, 
WENT-BEFORE 
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DIST0LINE[X,Y,X1,Y1,X2,Y2] 

calls:  MINUSP, SETN, DISTANCE, QUOTIENT, FDIFFERENCE, FPLUS, FTIMES, TIMES, 

MIN, SIN, ARCCOS 
called  by:  GRAZE, INLANE 
binds:  A,B,C,COSl,COS2 

DLFN [DNODE] 

calls :  FGREATERP, GETMB, GETCON, GETMD, MAX 

called  by:  BMEAS , DMEAS 
binds:  DNCON 

uses  free:  DMEASANS 

DMEAS tDBOX] 

calls:  MINUSP, FGREATERP, RESETLST,GETPROP,RESETSAVE, MARKON, MAPC,BLFN, 

DLFN, FTIMES, FDIFFERENCE, FPLUS 
called  by:  GETMD 

binds :  DMEASANS, RULECON, DASTLST, BMEAS ANS 

uses  free:  DAST, MDCOMB 

DS  P ADD  I NC  [  NAME ,  L AT ,  LON ,  T I  ME  ] 
calls:  FKCALL , DSPCNVRT 

called  by:  DISPLAY, STUFFLN,WEATHERMSG 

DSPADDINCS [NAME, INCLST] 

calls:  FKCALL, DSPCNVRT, MAPC 

binds:  INC 

DSPADDTRH [ NAME, ID, TYPE] 

calls:  FKCALL, DSPCNVRT 

called  by:  DISPLAY, STUFFLN,WEATHERMSG 

DSPCHGTRH l NAME, ID, TYPE ] 

calls :  DSPQUIET, DSPEXCH, FKSETVAL, FKCALL, DSPTTY 

DSPCMD [ CMD , WAITFLG ] 

calls :  EQP, FKCALL, GRATEK, TERPRI , GETTOPVAL, MONTEK 

called  by:  DESCRIBEMSG, PRINTRULEASSR 
binds:  DSPNOWAITFLG 

uses  free:  DSPTTYCODE,TEK4025 

DSPCNVRT IX] 

calls:  DCHCON, CRUNCH, NTH 

called  by:  DSPADDINC, DSPADDINCS, DSPADDTRH, DSPINIT 
uses  free:  SCRATCHTEN,DSPWORDl,DSPWORD2 


SDC  INTEGRATED  SERVICES  INC  SAN  DIEGO  CA  F/6  9/2 

STAMMER2  PRODUCTION  SYSTEM  FOR  TACTICAL  SITUATION  ASSESSMENT.  V— ETC(U) 
OCT  79  D  C  MCCALL*  P  H  MORRIS*  D  F  KIBLER  N00123-76-C-0172 

N0SC-T0-298-V0L-2 
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DSPERASEI] 

calls:  FKCALL , TEKWAIT 

DSPEXCH ( NAME ] 

calls:  FKCALL , RPTQ , RPLSTRING , ADD1 , ITIMES , NTHCH AR 

called  by:  DSPCHGTRH 

binds:  RPTN 

uses  free:  DSPEXCHBUF 

DSPEXP [BOX] 

calls :  MEMB, ZEROP, IGREATERP, MAPC, CONS, GETUPLE, ADD1 , APPLY, DREVERSE, 

CONCAT 

called  by:  PRINTRULEASSR 

binds :  X , DSPLST, COUNT, DSPOB JECTS , BLANK , COMMA 

uses  free:  OWNSHIP 

DSPGRAB [TTYNOJ 

calls:  IPLUS,OCTSAMEDIGITS,FKJSYS 

called  by:  CKCONFIGURATION 
uses  free:  DSPTTYCODE 

DSPINITU 

calls :  FKINIT, DSPQUIET, BKDSPBUF, DSPCNVRT, FKSETVAL  , FKCALL , DSPTTY, 

DSPTTYSTR, TERPRI 
called  by:  CKCONFIGURATION 
globals:  DSPNOWAITFLG 

DSPMAP [ ] 

calls:  FKSETVAL, INFILEPrPRINl, TERPRI 

called  by:  CKCONFIGURATION 

DSPNOMAP [ ] 

calls:  FKSETVAL 

DSPNUMATIX1 

calls:  MAPCAR,DSPNUMAT, PACKC, UNCRUNCH 

called  by:  DSPNUMAT, FKVALAT 

DSPQUIET [] 

calls:  FKCALL, FKJSYS, LOGOR, LLSH 

called  by:  DSPCHGTRH, DSPINIT 
uses  free:  DSPTTYCODE 
globals:  FORKDATA 
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DSPRELDtJ 

calls:  FKJSYS 

called  by:  DSPSAVE, PARTING 
uses  free:  DSPTTYCODE 

DSPSAVE [ ] 

calls :  FKCALL , DSPRELD, FKKILL, FKSAVE 

OSPSTAT [ 1 

calls:  FKJSYS/ LRSH 

uses  free:  FKJSYSAC1 
globals:  FORKDATA 

DSPTOP [WAITFLGl 

calls :  FKCALL/ EQP, RESETLST, GETTOPVAL , RESETSAVE , GRATEK 

binds :  DS  PNOWA I TFLG , FIRSTCMD 

uses  free:  DSPTTYCODE fTEK40 2 5 

DSPTTYU 

calls:  FKCALL, FKJSYS/ LOGOR/LLSH 

called  by:  DSPINIT,DSPCHGTRH 
uses  free:  DSPTTYCODE 
globals:  FORKDATA 

DSPTTYSTRM 

calls :  EQP, CONCAT, DECS AMEDIG ITS , IDIFFERENCE 

called  by:  CKCONFIGURATION,DSPINIT 
uses  free:  DSPTTYCODE 

ENDSTREAMtSl 

calls:  RPLACD 

called  by:  SERT 

ESTIMATE  tSITEl , SITE2 ,GAP] 

calls :  PRIN1 , TERPRI , MAPCAR , SPAN, GETATT, AUXINTERPOL 

called  by:  PREDICTPOS 

binds:  X 

uses  free:  EXPLAINFLAG 

EWMSG [TXT, EXTFLG] 

calls :  CASSERT, DISPLOB, NEWSYM, LIST, GETPOINT, OWNPOS 

called  by:  MSGMTR 

binds :  TIME, TEMPLACE1 , TEMPLACE2 , SNODE, SOURCE, BEAR, EMIT, WKNM 

uses  free:  SENSORANGE 
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iXLOOPU 

calls :  RESOUT, EXPLAIN, MSGMTR 

called  byt  STAMMER 
binds:  MSGFLG 

EXPLAIN  [ ) 

calls :  QHTAKE, MAPC, CONS , RETRIEVES , NEWVALOBJ , ERSETQ 

called  by:  EXLOOP 

binds:  DONEFLG, PLATFORM, MLANE, STORM, ID, ID-AMP, TYPE, VALUE, OBJECT 

uses  free:  ASSERTIONS, RELATIONS, PRODUCTIONS, RELATION, RULENAME 

•ANCYPRODIPROI 

calls :  PRIN1 , PRINT, TAB, GETPROP, PRETTYASSR, MAPC, TERPRI 

binds:  C, A, X, CART, CARTEL 

'ASTHAK  [  1 

calls:  MAPH, FUNCTION, MEMTEST 

uses  free:  MEMSIZE, MEMORY 

’IXLONGIX] 

calls:  FLESSP, FDIFFERENCE, FPLUS 

called  by:  AUXINTERPOL,GETPOINT 

’KACSH 

calls:  RPL ACA , ARRAY 

called  by:  FKCALL, FKSETVAL, FKVALI , SAILCALL 
binds:  Y,X 

global S:  FORKDATA 

’K ACSRETURN [ ARRAY ] 
calls:  RPL ACA , CONS 

called  by:  FKCALL, FKSETVAL, FKVALI, SAILCALL 
binds:  Y 

global s:  FORKDATA 

'KARRADR [ FKARRNAME , FK INDEX , FKNWORDS ] 
calls:  GETD, NUMBERP, ERROR, FKBCHECK, MAPC, EVAL , FKARRAYP, LOC,MAPCAR, 

LOGAND, OPENR, SUB1 , LRSH, EQP, LENGTH, IDIFFERENCE, IPLUS, ITIMES, 
ADD1 

called  by:  FKELTI, FKELTR, FKSETA 

binds :  FKADR, FKDIMS, FKSIZE, FKOFFSET, FKNDIM, FKPTR, FKLOW, FKARRY , X 
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FKARRAY  t  FKA , FKTYPE , FKSIZE, FKSIZE2] 

calls:  GETD, NUMBERP, ILESSP, NOFORK, FKSYMPUT,MAPC, EVAL, MAPCAR, ERROR, 

ADD1 r ITIMES, LIST, REVERSE, CONS, IPLUS, IDIFFERENCE, FKCORGET, LOGOR, 
FKHT, FKSHR, IMINUS, FKIDPB, LLSH, SET, VAG 
binds :  FKH I , FKOFFSET , FKNDIM, FKTOTALS IZ  E , FKDOPE , FKD IMS , FKLO, FKLOC, 

FKBYTP, FKDATAWD, FKS IZ  ES , WORD 
gl obal s :  FORKDATA 

FKARRAYPlA] 

calls:  IGREATERP, FKSHR, LOC 

called  by:  ARRLOC, FKCALL , SAILARG , FKARRADR 
binds:  SHR 

gl oba 1 s :  FORKDATA 

FKARRAYSIZEIA] 

calls:  LOGAND, OPENR, SUB1 , LOC 

FKARRAYTYPE [A] 

calls :  ZEROP, LRSH, OPENR, SUB1 , LOC, IDIFFERENCE, IPLUS, ITIMES 

called  by:  FKCALL, FKELT 
binds:  NDIM 

FKBCHECK [N, LO, HI] 

calls :  IGREATERP, ILESSP, ERROR 

called  by:  FKARRADR 

FKCALL [FKCX] 

calls :  LITATOM, FIXP, FLOATP, STRINGP, ARRAYP, IGREATERP, FKARRAYP, NOFORK, 

FKWAIT, FKIDPB, FKCALLERR, RPTQ, SETA, ERROR, PUTTYP, FKSACS, FKSW, 
FKACSRETURN, FKRACS, MAPC, FKHNDL, FKHT, FKACS, LOGOR, IPLUS, LOC, EVAL, 
FKSYM, FKCATYPE, SUB 1 , CONS, FKSR, ARRAYSIZE, IDIFFERENCE, ELT, 
FKARRAYTYPE, FKSHR, ADD1 , SET, FKRTN 

called  by :  DSPADDINC, DSPADDINCS , DSPADDTRH , DSPEXCH , DSPQUIET, DSPTOP,DSPTTY, 
DSPCHGTRH , DSPCMD, DSPERASE, DSPINIT, DSPSAVE 
binds :  FKHNDL, FKHT, FKCA, FKCBP, FKCABP, FKCID, FKCARG, FKBIAS, FKCTYPE, 

FKCRESLIST, FKCWRDS, FKCN, FKCARG S, FKRESULTYPE, FKRESULT, RPTN, X, 
FKCVAL 

globals:  FORKDATA, DSPNOW A ITFLG 

FKCALLERR I FKCID] 
calls:  ERROR 

called  by:  FKCALL, SAILCALL 

FKCATYPE IFKID] 

calls:  ILESSP, IGREATERP, CHCON1 

called  by:  FKCALL, FKVAL 
binds:  C 
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FKCORGET[SIZE] 

calls:  IGREATERP, ERROR , RPL AC A , FKSHR, FKPROG, IDIFFERENCE 

called  by:  FKARRAY 
binds:  SHRf X 

global s:  FORKDATA 

FKDDT [DDTFILE] 

calls:  ZEROP, EQP, NOFORK, ERROR, FKDDT_ ,  RES  ETFORM , FKHNDL, FKDDT, LOGOR, 

LLSH, LOGAND, FKJ  SYS , MKSTRING , FKSH , FKTTYSET 
called  by:  FKDDT, FKKILL 
binds :  FKHNDL , EV, DDT 

uses  free:  FKJ SYSAC1 , FKJ SYSAC2 
global s:  FORKDATA 

FKELT [ FKELT 1 A, FKELT 1 N , FKELT 1 WORDS ] 

calls :  APPLY* , FKARRAYTYPE , EVAL , FUNCTION, FKELTR, FKELTI 

FKELTI [FKELTI 1 A, FKELTI IN, FKELTI 1 WORDS] 

calls:  EVAL, FKARRADR,RPTQ, CONS, OPENR, IPLUS 

called  by:  FKELT 
binds:  PTR , ANS , RPTN 

FKELTR [ FKELTR I A, FKELTR IN, FKELTR [WORDS ] 

calls :  EVAL, FKARRADR, RPTQ, CONS, FKFLOAT, IPLUS 

called  by:  FKELT 
binds:  PTR, ANS, RPTN 

FKFLOAT [ADR] 

calls:  ASSEMBLE, VAG 

called  by:  FKELTR, FKVALI 

FKINITI PROGRAM] 

calls:  MEMBER, ILESSP, IGREATERP, FKRACS, RPTQ, ARRAY, HARRAY, INFILEP, 

UNPACK, PACK, LIST, ERROR, FKJ SYS, MKSTRING, LOGOR, LLSH, LRSH, 

RES ETFORM, FKTTYSET, FKSW, ADD1 , ELT, EQP, LOC, GETBLK, SUB1 , IPLUS, 
IDIFFERENCE 

called  by:  DSPINIT, NOFORK 

binds :  PROGFILE, FKJFN, FKHNDL , HALTED, EV, HALTADR, PGS, SOURCE, DEST, FKSHR, 

FKACS , L I SPBLOCK , RPTN , S I Z  E , FKHT, FKSYMACS , FKDDT 
uses  free:  FKJSYSAC2,FKJSYSAC1 
globals:  FORKDATA 


FK J SYS [ PK J SYSNO , ARG 1 , ARG2 , ARG 3 , ARG4 , ARG5 ] 
calls:  ASSEMBLE, VAG, FKJSYSARG, LOC, AC 

called  by :  FKTIME, DSPQUIET, DSPSTAT, DSPTTY, FKKILL, FKSR, FKSW, FKTTYSET, 
FKWAIT, BKDSPBUF , DSPGRAB , DSPRELD, FKDDT, FKINIT, FKSAVE 
uses  free:  FKJSYSAC3,FKJSYSAC2 ,FKJSYSAC1 

FKJSYSARGIXJ 

calls:  STRINGP, ZEROP, ARRAYP, NUMBERP, CHCON1 , NTHCHAR, CONCAT, CHARACTER, 

IPLUS, LOC, LSH, LOGAND, LOGOR, IQUOTIENT, LLSH, IDIFFERENCE, ITIMES, 
IREMAINDER, ERROR, VAG 
called  by:  FKJSYS 
binds:  ARG, S 

uses  free:  FKJSYSTR 

FKKILL [] 

calls :  EQP,  FKJSYS, RELB LK, EVALV, FKHNDL , RSH , FKPROG , FKJFN, FKDDT, FKSHR, 

VAG, LRSH, IDIFFERENCE 
called  by:  DSPSAVE, PARTING 
binds:  FKPROG, DDT, SHR 

uses  free:  FKJSYSAC1 
globals:  FORKDATA 

FKRTNITYPE, A, N] 

calls:  ZEROP, ELT, ASSEMBLE, VAG, IPLUS, LOC, ERROR 

called  by:  FKCALL , SAILCALL 

FKSAVE EFILE] 

calls :  ERROR, FKJSYS, MKSTRING, LOGOR, LLSH, FKHNDL, INFILEP 

called  by:  DSPSAVE 

binds:  JFN 

uses  free:  FKJSYSAC1 

globals:  FORKDATA 

FKSETA [ FKARRY , FKINDEX , FKEXPR ] 

calls :  EVAL, FKARRADR, LENGTH , MAPCAR, CLOSER, ADD1 

binds:  FKVAL , FKPTR , FKV 

FKSETVAL [ FKADR , FKB IAS , FKVAL ] 

calls :  IGREATERP, NUMBERP, NOFORK, FKWAIT, HELP, RPLACD, MAPC, FKSACS, FKSW, 

FKACSRETURN, FKHNDL, FKHT, FKACS, LOGOR, IPLUS, LOC, FKSYM, EVAL, LIST, 
LENGTH , COPY, NTH , FKIDPB , ERROR 
called  by:  DSPMAP,DSPNOMAP,DSPCHGTRH,DSPINIT 
binds:  VAL, FKHNDL, FKHT, FKACS, FKBP, FKRESULT 

global 8:  FORKDATA 


FKSRlA,I,STR] 

calls:  IGREATERP, RPTQ , SETA, FKJ SYS , LOG OR, I PLUS, LOC , NCHARS , IDI FFERENCE , 

ARRAYSIZE, SUBl , ADD1 , IQUOTIENT, ZMINUS 
called  by:  FKCALL 

binds:  WDS, SIZE, ROOM, RPTN,DESTPTR 

FKSW ( FKHNDL , I , FKNOWAITFLG ] 

calls :  ILESSP, EQP, FKJSYS , RESETFORH, FKHALT, LOGAND, RADIX, HELP 

called  by:  FKCALL, FKSETVAL, FKSYM, FKVALI, SAILCALL, FKDDT, FKINIT 

binds:  EXPECTED, HALTED 

uses  free:  FKJ SYSAC2 

global S:  FORKDATA, DSPNOWAITFLG 

FKSYH ( ID, FKHT, NOBREAK] 

calls:  ZEROP, SETA, FKSACS, FKSW, FKRACS, ERROR, FKHT, NOFORK, FIXP,GETHASH, 

FKSYMACS, FKHNDL, GETRADIX50, ELT, FKSYMPUT 
called  by:  FKCALL, FKSETVAL, FKSYMP,FKVALI, SAILARG, SAILCALL 
binds:  P, FKHNDL 

global S:  FORKDATA 

FKSYMP[ID] 

calls:  FKSYM 

FKSYMPUT I FKHT, ID, VI 

calls:  PUTH ASH, FKHT., LIST 

called  by:  FKARRAY, FKSYM 
binds:  HTL 

globals:  FORKDATA 

FKTIME [FKEXPR] 

calls :  FKJSYS, FKHNDL, EVAL, FQUOTIENT, IDIFFERENCE, LIST, FPLUS 

binds :  FKHNDL, FKFORKTIME, FKLISPTIME, FKRESULT 

uses  free:  FKJSYSAC2,FKJSYSAC1 
global s :  FORKDATA 

FKTTYSETIBOOL] 

calls:  FKJSYS 

called  by:  FKDDT, FKINIT 

uses  free :  FKJ SYSAC3 , FKJSYSAC2 , FKTTYSETCALLED, FKTIW, FKFMOD, FKCC2 , FKCC1 

FKVAL [ FKADR, FKB IAS , FKWORDS ] 

calls:  APPLY*, FKCATYPE, FKVALI 

FKVALAT t ID, BIAS, NVALS1 

calls:  DSPNUMAT, APPLY, LIST, FKVAL I 
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FKVAL I [ FKADR, FKB IAS  ,  FKWORDS , FKREAL 1 

calls  s  IGREATERP,  NOFORK, FKWAIT, FKIDPB, FKSACS, FKSW, FKRACS, HELP, RPTQ, 

FKACSRETURN, FKHNDL , FKHT, FKACS, LOGOR, IPLUS, LOC, FKSYN, EVAL, CONS, 
FKFLOAT, OPENR 

called  by:  FKVAL , FKVALAT, FKVALR 

binds :  FKHNDL , FKHT, FKACS , FKBP, FKRESULT, RPTN 

globals:  FORKDATA 

FKVALR [ FKADR, FKB IAS , FKWORDS ] 
calls:  APPLY*, FKVALI 

FKWAIT [FKHNDL] 

calls :  MEMB, FKJSYS, DISMISS, HELP, LRSH, LOGAND 

called  by:  FKCALL,FKSETVAL, FKVALI 

uses  free:  FKJSYSAC2,FKJSYSAC1,FKSTATUS 

FKXtFKCX] 

calls:  EVAL, LIST 

FREEZE [ ] 

called  by:  MSGMTR 
uses  free:  FREEZEFLG 

GAMF [WLK, OVERRIDE] 

calls :  FGREATERP, FLESSP, PRINl ,GETCON, ABS, EQP 

called  by:  MODIFIER, NICEANSWER, YESNO 
binds:  CONFI,ACON 

GETATTlREL, NAME] 

calls:  RPLACA,GETUPLE, STRIPSTREAM,GETSH 

called  by :  ADDIS, BEARING, COURSE, DISSIMILPLAT, ESTIMATE, LOC-TIME, LOCATION, 
ONEPOINT, PLATPOS, PREDECESSOR, PREDICTPOS, RANGE, SPEED, STUFFLN, 
SUCCESSOR 
binds:  SPEC 

GETATTB [REL, NODE] 

calls:  RPLACA,GETUPLE, STRIPSTREAM, GETSH 

called  by:  ADDIS, POSS-REPORT, PREDECESSOR, SUCCESSOR 
binds:  SPEC 

GETCONtSOMAST] 

calls:  ATOM,FDIFFERENCE,GETMB,GETMD,MAPCAR,GETCON 

called  by:  BLFN,DLFN,GAMF,GETCON,GREATESTPROB, IMPLIESASRT, MODIFIER, 
PRINTRULEASSR, YESNO, ANDHACK, NOTHACK, UNLESSHACK 


f 
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GETHlARGS] 

calls:  ELTD,LOCH 

called  by:  GETSH,GETSTRIP 
uses  free:  MEMORY 

GETMARK  t NODE] 

calls:  GETPROP 

called  by:  GETMB,GETMD 

GETMBIBAST] 

calls:  MAPC  , GETPROP, GETMARK , BMEAS 

called  by:  BLFN , DLFN , GETCON 
binds:  HNDL , MBCOMB 

GETMDlDAST] 

calls:  MAPC r GETPROP, GETMARK rDMEAS 

called  by:  BLFN, DLFN, GETCON 
binds:  DNDL , MDCOMB 

GETMRVAL [ X , COPYFLG ] 
calls:  SUBLIS 

called  by:  MASSAGEl,ORACLEHACK, SWEEPER 
uses  free:  MAPRETALIST  . 

GETPOINT [POS, BEAR, RANGE] 

calls :  EQUAL, FGTP, FQUOTIENT, SIN, COS, ARCSIN, FPLUS, FTIMES, ABS, LIST, 

ARCCOS, MAX, MIN, FDIFFERENCE, FMINUS, FIXLONG 
called  by:  EWMSG 

binds :  SINLAT, COSPSI , COSLAT, SINPSI , COSBEAR, NEWLAT, COSNEWLAT, TMP, TMP2 , 

NEWLONG , LAT, PSI , LONG 

3ETPULSAR [NODE] 

calls:  GETPROP 

called  by:  JUSTBUILD, MAPRETDO 

3ETRADIX50IS] 

calls:  ILESSP, IGREATERP, RPTQ , NCHARS, SUBSTRING, CHCON1 ,GNC, IDIFFERENCE, 

IPLUS, ITIMES 
called  by:  FKSYM 

binds:  RADTMP , RAD , L EN , TS , RPTN 

GETSHlARGS] 

calls:  GETH,PUTH, APPEND, NEWSTREAM 

called  by:  GETATT,GETATTB, PUTSH, RETRIEVES, RETSTREAM, SERT 
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GETSTRIPIARGS] 

calls:  STRIPSTREAM, GETH 

called  by:  ASSERT, CASS ERT, JUSTBUILD, RETRIEVER, YESNO 

GETUPLEIASSERJ 

calls:  EVAX< 

called  by:  DPPEXP, GETATT, GETATTB, IMPLIESASRT, NEWVALOB J , RESULTPRINTER, 
RETPULSEDO, RETRIEVER, RETRIEVES 


GRATEK [ ] 

calls :  TEKCOM, PRINCHAR, PRINl , JSYS , TERPRI , DOBE 

called  by:  DSPCMD,DSPTOP 

GRAZ  E [ SI , S2 , T1 , T2 1 

calls:  CENTROID, LESSP,DISTOLINE 

binds:  POS1 , POS3 , POS4 , POS2 

uses  free:  PATROLRANGE 

GREATER-THAN  t  Q1 , Q2 ] 
calls:  GREATERP 


GREATESTPROB [POSLIST] 

calls:  GREATERP, EQP, MAPC,GETCON 

called  by:  IDENT, MEDIUM 
binds:  ANSCON,ANS,A 


HLPEXPLNU 

calls:  PRINl, TERPRI 


IDENT [NAME] 

calls :  RETRIEVER, LIST, GREATESTPROB 

called  by:  DISPLAY 
binds:  POSIB,ANS 

IMPLIESASRT [ NODE] 

calls :  EQP, TERPRI , PRINl , MAPC , GETPROP , GETCON , GETU  PLE , MEMBER, APPEND, 

LIST, SPACES 
binds:  X,Y 

uses  free:  RULE 


IN-LANE[MLANE,POSl 

calls:  CENTROID, LAST, FGREATERP, LANERANGE 

binds:  X,Y 
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INCLUDEPLAT [ PNE] 

calls:  MAPC , RETRIEVES fADDIS 

called  by:  STARTUP 

INLANE [X,Yf LANE] 

calls:  SOME , SETN , LESSP , DI STOL INE 

binds:  XI, Yl, X2, Y2, LANEPOINT 

uses  free:  MERCHANTLANEWIDTH 

INSIDE [POS, STORM] 

calls:  APPLY, APPEND, CENTROID, CONS, INTERIOR 

INTERIOR I OLAT, OLON, POLYGON] 

calls :  LESSP, SETN, MAPC, LAST, DIFFERENCE, DIRECTION, PLUS, GREATERP, ABS 

called  by:  L INPOLY, INSIDE 

binds :  SUM, INC, POS1 , POS, LAT, LON, LAT1 , LON1 

INTERPOLATE  [TXT] 
called  by:  MSGMTR 

JUGGLE [PAIR, INSERTITEM] 
calls:  LIST 

JUSTDUILDISPEC, EV, NUMBER] 

calls:  PUTPROP, SET, SAVEPULSAR, SERT, PULSE, MASSAGE1 ,GETSTRIP,GENSYM, 

CONS, REVERSE, GETPROP,GETPULSAR 
called  by:  CONSTRUCT 
binds:  MASSAGESPEC, NEWNODE, NEWFLG 

uses  free:  ASSERTIONS, RESULTLIST 

LANERANGE [ ALAT, ALON, BLAT, BLON, CLAT, CLON] 

calls:  SETN , COS , SIN , FT IMES , ABS , FDI FFERENCE , ARCCOS , FQUOTIENT, FPLUS , 

SUBTEND 
called  by:  IN- LANE 

binds :  A1 , B1 , Cl , A2 , B2 , C2 , A3 , B3 , C3 , CAT, CAN, CBT, CBN, CCT, CCN, SAN, SBN, SCN, 

SAT, SBT, SCT 

LESS-THAN[Q1,Q2] 

calls:  GREATERP 

LINEREADU 

calls:  BKLINBUF,READP, READLINE 

called  by:  DEFINEPD, WELCOME 

LINPOLY I PT1 , PT2 , POLY] 

calls:  CROSSBOUNDARY, INTERIOR 

called  by:  TRACKINPOLY 
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LOC-TIME [S] 

calls:  NCONC1, CENTROID, GETATT 

LOCATION [S3 

calls:  CENTROID, GETATT 

LOCH[ARGS,PUTFLG3 

calls :  EQUAL, PREHASH, ELT, NEXTH , ADD1 

called  by:  GETH,PUTH 

binds:  LOC,CONT 

uses  free:  MEMORY, MEMTESTCNT 

M[L3 

calls:  NCONC, MAKEFILE 

uses  free:  DSPLAFNS 

MAKEPD [ NAM, CO , AC , TRUST] 
calls:  PUTPROP, CONS 

called  by:  DEFINEPD 

uses  free:  PRODUCTIONS 

MAKEPRINTERELN3 

calls:  TERPRI , MAPC, SPACES, PUTPROP, GETPROP, PRIN1 , READ, APPEND, CONS 

binds:  PFORM , NEWFORM , X 

MAPH [ ARY , ARYS2 , ARYFN 3 

calls:  GREATERP, APPLY*, ELT, ELTD, ADD1 

called  by:  NEWHASH, FASTHAK 

binds:  COUNT, CONTENT 

MAPRETDOISELT, AI3 

calls :  SOMEPULSE, GETPULSAR, CONS , FUNCTION, RETPULSEDO 

called  by:  MAPRETRIEVE 

MAPRETRIEVE [MAPRETX, MAPRETINFO, MAPRETFNJ 

calls :  MAPSTREAM, RETSTREAM, CONS, FUNCTION, MAPRETDO 

called  by:  ANDHACK, NOTHACK, UNLESSHACK 

uses  free:  MAPRETALIST 

MAPSTREAM [MAPSTREAMX, MAPSTREAMINFO, MAPSTREAMFN3 
calls:  MAPC, TCONC, APPLY*, CONS 

called  by:  MAPRETRIEVE 
binds:  X 
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MARKOFF [NODE] 

calls:  REMPROP 

MARKON [NODE, MARK] 
calls:  PUTPROP 

called  by:  BMEAS , DMEAS 

MAS SAG El [SPECLIST] 

calls:  VAR? , MAPCAR, GETMRVAL 

called  by:  CONSTRUCT, JUSTBUILD,UNLESSHACK 

binds:  X 

MATCH ER[ LI, L21 

calls:  DREVERSE , CONS 

called  by:  SERT 
binds:  ANS 

MAYBE  [L] 

calls:  CASSERT 

MEDIUM [NAME] 

calls :  RETRIEVER, LIST, GREATESTPROB 

called  by:  DISPLAY 
binds:  TEMPI, RETURNER 

MELD [ID, MED] 

calls:  PACK, LIST 

called  by:  DISPLAY 
binds:  A,B 

MEMDENSITYU 

calls :  PRIN1 , FTIMES, FQUOTIENT, TERPRI 

uses  free:  MEMS IZE,MEMFILLED 

MEMSAVE[FEE] 

calls :  SET, MAKEFILE, TERPRI , PRIN1 , FILECOMS , CLEARBUF 

uses  free:  MEMORYCOMS 

MEMTESTtX, Y] 

calls:  PRIN1, LENGTH, TERPRI 

called  by:  FASTHAK 
uses  free:  COUNT 

MIDP[P1,P2] 

calls :  GREATERP, FDIFFERENCE, ABS, MINUS, TWO- PLACE, FQUOTIENT, FPLUS 

called  by:  DISPLOB 
binds:  TEMP2 
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MODIFIER U 

calls*.  MEMBER,  GAMF,  PR  INI  ,GETCON,  TWO- PLACE 

binds:  CON 

uses  free:  NODE, OVERCONF 

MONTEK [ ] 

calls:  TEKCOM 

called  by:  DSPCMD 

MSGMTR [ ] 

calls :  BEYONDINTEREST, INTERPOLABLE, NUMBERP, INFILE, FREEZE, CLOSEF? , 

UNFREEZE, OWNMSG, DESCRIBEMSG, PRINl ,TERPRI, WEATHERMSG, SENSORMSG, 
EWMSG, INPUT, READ 
called  by:  EXLOOP 

binds:  OLDIN,MSG 

uses  free:  OWNSHIP,MSGFILE 

NEAREST [PT,LST] 

calls:  FLESSP,MAPC, DISTANCE 

called  by:  SPAN 

binds:  TEMP,Y,ANS,X 

NEWHASH [ ] 

calls:  CREATH , MAPH , PLUS, IQUOTIENT, FUNCTION, PUTH 

called  by:  PUTH 

binds:  LEFT,A,OLDSIZE, RIGHT 

uses  free:  MEMS I ZE, MEMORY 

NEWSTREAMH 

calls:  CONS 

called  by:  GETSH 

NEWSYM [ NAME ] 

calls :  PUTPROP, ADD1 , GETPROP, CONS, PACK, APPEND, UNPACK 

called  by:  EWMSG, OWNMSG, SENSORMSG 

uses  free:  SYMBOLS 

NEWVALOBJ [ ARRT] 

calls:  LESSP, LENGTH, GETUPLE, NUMBERP, MEMB, CONS 

called  by:  EXPLAIN 

binds:  TUPLE, VL,OJ 

uses  free:  OBJECT, VALUE 


NBXTHtLOC, ARG] 

calls:  GREATERP, IDIFFERENCE, IPLUS 

called  by:  LOCH 
binds:  NEWLOC 

uses  free:  MEMSIZE 

NICEANSWER [ ANSI ] 

calls:  GAMF,  PRIN1 , TERPRI 

called  by:  PRETTYANS 

NOFORK ( 1 

calls:  PRIN1 , APPLY* , READ, FKINIT 

called  by:  FKARRAY,FKCALL,FKDDT,FKSETVAL,FKVALI,FKSYM,SAILCALL 
g 1 obal s :  FORKDATA 

NOTHACK [CONDITIONS, ACTIONS, EV] 

calls:  ORACLEHACK,MAPRETRIEVE, FUNCTION, LESSP,GETCON, SWEEPER, CONS, LIST 

called  by:  SWEEPER 
binds:  P,XrCLIST 

OCCURPR INTI TIMES, NODE] 

calls:  ZEROP, EQUAL, PRINTRULEASSR,QHTAKE,GETPROP, SUB1 

binds:  X,Y,Z 

uses  free:  RULE 

OCTSAMEDIGITS [X] 

calls:  LESSP, IPLUS, IREMAINDER, ITIMES, OCTSAMEDIGITS , IQUOTIENT 

called  by:  DSPGRAB, OCTSAMEDIGITS 

ONEPOINT [ NODE, GAP] 

calls :  PR INI , TERPRI ,  FTINES , GET ATT, LIST, FDIFFERENCE, FPLUS, MAPCAR, SPAN, 

CENTROID, AUXINTERPOL 
called  by:  PREDICTPOS 
binds:  LAT, LONG, X, POS, Y 

uses  free:  EXPLAINFLAG 

OPSIDES [A,B, P,Q] 

calls:  ROTSENSE 

called  by:  CROSSLINES 

ORACLEHACKlSPECl 

calls:  VAR?, EQUAL, RPLACD, NCONC, CASSERT, GETMRVAL, GETPROP, LAST, NLEFT, 

APPLY, RPLACA 

called  by:  ANDHACK, NOTHACK, UNLESSHACK 
binds :  ORTYPE, LASTCONS, PTR, LAST- ARG, ANS 
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ORBUILD [SPEC, EV] 

calls:  CONSTRUCT, LENGTH 

called  by:  CONSTRUCT 
binds:  COUNT 

ORHACK [CONDITIONS, ACTIONS, EV] 
calls:  MAPC, SWEEPER, CONS 

called  by:  SWEEPER 
binds:  TEMP2 

OWNMSG [TXT] 

calls:  CASSERT, DISPLAY, NEWSYM, LIST 

called  by:  HSGMTR 
binds:  SNODE 

uses  free:  OWNSHIP 

OWNPOS [TINE] 

calls:  PLATPOS 

called  by:  BEARING, EWMSG, RANGE 

uses  free:  OWNSHIP 

PARTING [ ] 

calls:  PRIN1 , TERPRI , PKKILL, DSPRELD 

called  by:  STAMMER 
uses  free:  DSPLAYFLG 

PLATPOS [PLAT, TIME] 

calls :  PRIN1 , TERPRI , MAPC AR, RETRIEVER, LIST, CDADR, SUBSET, EQUAL, GETATT, 

PREDICTPOS 
called  by:  OWNPOS 
binds:  X,Y,Z 

uses  free:  EXPLAINFLAG 

POSS-REPORT [ SI , S2 , PATROL] 

calls:  DISSIMILPLAT, MAPC, GETATTB 

binds:  PLAT1 , SUCCESSFLG , SNG , PL AT2 

PQILJ 

calls:  SHOWPRINT , GETPROP 

binds:  SYSPRETTYFLG 

PREDECESSOR [SITE] 

calls:  LESSP, MAPC, GETATTB, GETATT, RETRIEVES 

called  by:  COURSE, SPEED 

binds :  PLAT, TOSSITE, TOSX, PRED, TOSPRED, X 
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PREDICTPOS INODELIST, TIME] 

calls :  FLESSP, MAPC, GETATT, ESTIMATE, FQUOTIENT, FDIFFERENCE, ONEPOINT 

called  by:  PLATPOS 

binds :  XT, LB2 , LBT2 , LB, LBT, UB2 , UB , UBT, X 

uses  free:  UBT2 

PREHASH [LI 

calls:  LITATOM,NUMBERP, STRINGP, ZEROP, SETN, ADD1, IREMAINDER, IPLUS, LSR, 

LOGAND, LOC, VAG, MKATOM, PREHASH, HELP, SUB1 
called  by:  LOCH, PREHASH 
binds:  N,C 

uses  free:  MEMSIZE, PREHASHSUM1 , PREHASHSUM 

PREPALIST [CON, ASS, ALIST] 
calls:  VAR?, ASSOC, CONS 

called  by:  RETPULSEOO 
binds:  C,A 

PRETTYANS [ANSLST] 

calls:  PRINl ,TERPRI, MAPC, NICEANSWER 

PRETTYASSR [ NODE , FORMAT , OVERCONF ] 

calls :  GREATERP, PRINl , FRPLACD, MAPC , MEMB , CONS , EVAL , GETPROP, LENGTH, LIST, 

PLUS , NTH , ASSRPRINT 

called  by:  FANCYPROD , PRINTRULEASSR , RECAPCONCS , RESULTPR INTER 
binds:  LSTFLG, BODY, FORMLST, USEFORM, I, $$END 

uses  free:  ASSERTION 

PRINCHAR [CODE] 

calls :  RESETFORM, ECHOCONTROL, PRINl , CHARACTER 

called  by:  GRATEK, TEKTEST 

binds:  X 

PRINTRULEASSR [RULEASSRTS] 

calls :  ATOM, FLESSP, PRINl , MAPC, TAB, PRETTASSR, WAITER, GBTCON, PRETTYASSR, 

TERPRI , DSPCMD, DSPEXP 
called  by:  OCCURPRINT,RULEXP 

binds:  Y 

uses  free:  DSPLAYFLG 

PULSAR U 

calls:  CONS 

called  by:  SAVEPULSAR 
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PULSE [PULSAR] 

calls:  APPLY* , RPL AC A , CONSTANT , CONS , RPLACD 

called  by:  JUSTBUILD 
binds:  CELL,PTR 

PUTHlARGSf AVAL] 

calls:  IGREATERP, NEWHASH, SETA, SETD, ADD 1 , LOCH 

called  by:  GETSH, NEWHASH 
binds:  LOC 

uses  free:  MEMORY, MEMFULLSIZE, MEMPILLED 

PUTSH [ARGS, AVAL] 

calls:  PUTSTREAM, GETSH 

called  by:  ADDH 

PUTSTREAM [ S , X ] 

calls :  HELP, TCONC , MAPC , CONS, APPLY* 

called  by:  PUTSH 

binds:  SUSP 

uses  free:  FREEZ  ELST, FREEZ  EFLG 

QHASKtINBUF] 

calls :  MEMB, NUMBERP, TERPRI , TCONC, BEEP, QHLIST, MAPRINT, MAPC, RESETLST, 

RESETSAVE, CONTROL, ECHOMODE, RAISE, ECHOCONTROL , QHG  ET , PEEKC,CONS, 
PRIN1 ,READC, CHCON1 , GETS YNTAX, CHARACTER, MKATOM, CONCAT, SUBSTRING 
RESETFORM, READ 
called  by:  QHFOLLOW 

binds :  PTR, BUFPTR, CHAR, CODE, NEWPTR, ITEM, NUM,  X 

QHCLEARN 

calls:  CLRHASH 

called  by:  QHFOLLOW 
uses  free:  QUERYHASHPTR 

QHFOLLOW [ LL , BUFPTR , QHMATCH J 

calls :  STRINGP, TCONC, QHCL EAR, QHPREP, QHMAKE, TERPRI , QHSHOW, MAPRINT, 

CL EARBUF, QHFOLLOW, EVALA, CONS, PRINl , NTHCHAR, CONCAT, CHARACTER, 
SUB STRING, QHASK, READ, EVALV, EVAL, REVERSE 
called  by:  QHFOLLOW, QHTAKE 
binds:  L,X,ALIST,QHVAL 

uses  free:  QHVAR 

QHLIST [PTR] 

calls:  PRINl, TERPRI, PRINT, RPTQ, QHLIST, QHGET, NTHCHAR, SUBSTRING, 

IDIFFERENCE 

called  by:  QHASK, QHLIST 
binds:  ITEM, RPTN 


QHMAKE [QHMAKEX, QHMAKEY , SHOWFLGJ 

calls :  MEMB, MAPC , PRIN1 , TERPRI , PRINT, RPTQ , QHPUT, QHMAKE, NTHCHAR , 

SUBSTRING, EVAL,MKATOM, NCHARS, CHCONl , IMINUS,QHGET, ADD1 
called  by:  QHPOLLOW, QHMAKE, QHPREP 
binds:  CHAR CODE , NEWPTR , PTR , X , RPTN 

uses  free:  QUERYHASHPTR 

QHPREP [ FOCUS, QHLST, SHOWFLG, STK] 

calls:  QHPREP , MAPC , NTHCHAR , G  ETPROP , HELP , CONS , QHMAKE 

called  by:  QHFOLLOW, QHPREP, QHSHOW 
binds:  F,X 

QHSHOW [LI 

calls:  QHPREP 

called  by:  QHFOLLOW 

QHTAKElL] 

calls:  QHFOLLOW, CONS 

called  by:  EXPLAIN, OCCURPRINT,RULEXP 

RANGE [SITE] 

calls :  GETATT, OWNPOS, CENTROID, DISTANCE 

binds:  TIME,POSl,POS2 

RECAPCONCS [ ] 

calls:  TERPRI, MAPC, PRETTYASSR 

uses  free:  ASSERTION 

RESOUT [ 1 

calls :  MAPC, INTERSECTION, RESULTPRINTER 

called  by:  EXLOOP 
uses  free:  RESULTLIST 

RESULTPRINTER [RES1 1 

calls:  MEMB, MAPC, PRIN1, TERPRI, GETUPLE, PRETTYASSR 

called  by:  RESOUT 
uses  free:  DULLREL 

RETPULSEDO t SELTAI ] 

calls :  DECLARE, GETUPLE, PREPAL 1ST, APPLY* 

called  by:  MAPRETDO 

binds :  ASS, MAPRETALIST, MAPRETINFO, MAPRETX , MAPRETFN , SELT, AI 
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RETRIEVER [SPEC] 

calls:  MAPC,MAP2C,GETSTRIP,RETVARS,GETUPLE, VAR?, CONS 

called  by:  IDENT, MEDIUM, PLATPOS , WHAT2FORMFN , WHATFORMFN , WHOSE2FORMFN 

binds:  RES1,RES,W,A,B 

RETRIEVES  t AT, OBJ, VAL, SEL] 

calls:  ILESSP, MEMBER, RPLACA, RPLACD, MAPC, NCONC, LAST, STRIPSTREAM, GETSH , 

ADD1 , MAPCAR, NTH , GETUPLE, CONS 

called  by :  EXPLAIN, INCLUDEPLAT, PREDECESSOR, STARTUP, SUCCESSOR 
binds :  SPEC, LAST, ASSES , X, ANS , ELT, ASS, ONEFLG 

RETSTREAMlCl 

calls:  VAR?, MAPC, RPLACA, RPLACD, ASSOC, GETSH 

called  by:  MAPRETRIEVE, UNLESSHACK 
binds:  PTR,XASSOC, FOLLOW, S, SCRATCH, X 

uses  free:  MAPRETALIST 

RETVARS [ SPEC ] 

calls:  VAR?, MAPCAR 

called  by:  RETRIEVER 
binds:  ITEM 

ROTSENSE[A,B,C] 

calls:  LESSP,GREATERP,MINUSP, DIFFERENCE, DIRECTION 

called  by:  OPS IDES 
binds:  ANGLE 

ROUGHLY-THE- SAME-COURSE- AS IQ1 ,Q2] 
calls:  PLUS, GREATERP, DIFFERENCE 

ROUGHLY-THE-SAME-SPEED-AS [Q1 ,Q21 

calls:  PLUS, TIMES, GREATERP, DIFFERENCE 

RULEXP [RULE, NODE] 

calls :  ZEROP, EQUAL, PRIN1 , TERPRI , PR I NTRULEASSR , QHTAKE, GETPROP, SUB1 

binds:  X, COUNT, Y,Z 

SAILARG [FKARG, FKHT] 

calls :  ATOM, FMEMB, LITATOM, STRINGP, FKARRAYP, FIXP, FLOATP, MAP, LAST, LIST, 

EVAL, FKSYM, SAILSTRING, IPLUS, LOC, FKSHR, ERROR, LLSH, FIX, FLOAT, 
LOGOR 

called  by:  SAILCALL 

binds :  FKVARBL, FKVALUE, VARTYPE, FKTYPE, FKCALLTYPE, FKRV, FKARRY, 

FKRESULTS,X 
globals:  FORKDATA 


5AI L ARRAYS IZ  E ( A] 

calls :  RPTQ,LOC, LRSH , OPENR, S0B1 , IDIFFERENCE, CONS, REVERSE 

binds:  NDIM, X, ANS,RPTN 

5AILCALL [ FKCX ] 

calls:  ATOM, IGREATERP, ERROR, SETA, FKCALLERR,FKIDPB, MAPC, PUTTYP, FKSACS, 

FKSW , FKACSRETURN , FKRACS , FKHNDL , NOFORK , FKHT, FKACS , LOGOR, I PLUS , 
LOC, FMEMB , FKS YM, SAILARG , CONS , ADD1 , LENGTH , SET, FKRTN 
binds :  FKHNDL , FKHT, FKCA, FKCBP, FKCABP, FKRESULTB ITS , FKCARG, FKTYPE , 

FKCRESLIST, FKCN, FKCARGS, FKRESULT, FKRESULTYPE, FKCID, WORD, X 
uses  free:  FKTTYSETCALLED 
globals:  FORKDATA 

SAILSTRING [STRING] 

calls:  RPTQ,CHCON, CONS, REVERSE, IPLUS,LLSH 

called  by:  SAILARG 

binds:  CHLIST, PACKEDLIST, VAL, ZEROS, RPTN 

3AME-AS [W, U] 

SAVE PULSAR [NODE] 

calls:  PUTPROP, PULSAR 

called  by:  ASSERT, CASSERT, JUSTBUILD 

SENSORMSG ( TXT] 

calls :  EQUAL, CASSERT, DISPLAY, NEWSYM, LAST, LIST 

called  by:  MSGMTR 

binds :  SNODE, LAT, LON, SOURCE, TIME, STR, WKNM 

SERT [SPEC, NODENAME] 

calls :  MEMB, RPTQ, ADDH, ENDSTREAM, SUB1 , LENGTH, CONS, MATCHER, BUMP, GETSH 

called  by:  ASSERT, CASSERT, JUSTBUILD 
binds:  LEN, A,RPTN 

SOMELINESEG  tSOMELINESEGX, SOMELINESEGFN] 
calls:  SOME, APPLY* 

called  by:  CROSSBOUNDARY, TRACKINPOLY 
binds :  SOMELINESEG PT1 , SOMELINESEGPT2 

SOMEPULSE [PULSAR, PULSARDATA, SOMEPULSEFN] 
calls:  APPLY*, TCONC, CONS 

called  by:  MAPRETDO 
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SPAN [  LI ,  L2  ] 

calls !  IGREATERP, LENGTH , MAPCAR , LIST, NEAREST 

called  by:  ESTIMATE, ONEPOINT 
binds:  X 


SPEED I SITE] 

calls :  LESSP,GETATT, CENTROID, PREDECESSOR, SUCCESSOR, SPEEDM, DISTANCE, 

PDIPPERENCE 

binds :  TIME, POS, PRED, SUC, TSUC, PSUC, TPRED, PPRED 

SPEEDAUX [ T1 , T2 , DIST] 

calls:  PQUOTIENT, PDIPPERENCE 

called  by:  SPEEDM 

SPEEDPROM[POSl ,Tl,POS2 ,T21 

calls:  CENTROID, SPEEDM, DISTANCE 


SPEEDM (T1,T2, DIST] 

Calls:  ABS, SPEEDAUX, FQUOTIENT 

called  by:  SPEED, SPEEDFROM, SWR 


STAMMER [ 1 

calls:  MAPC , WELCOME , EXLOOP, APPLYRULE, PARTING 

uses  free:  PRODUCTIONS 


STARTUP U 

calls:  RETRIEVES, INCLUDEPLAT, MAPC, STUFFLN 

called  by:  CKCONFIGURATION 

STATE (LJ 

calls:  CASSERT 


STRIPSTREAMlSJ 

called  by:  GETATT,GETATTB,GETSTRIP, RETRIEVES, UNLESSHACK 


STUFFLN l MLN] 

calls:  DSPADDTRH, MAPC, GET ATT, DSPADDINC 

called  by:  STARTUP 
binds:  VER 


SUBTEND I LAT1 , LON1 , LAT2 , LON2 ] 

calls :  EQP, ABS, PDIPPERENCE, COS, PPLUS, ARCCOS, PQUOTIENT, FTIMES, FMINUS 

called  by:  DIRECTION, DISTANCE, LANERANGE 
binds:  C1,C2,C3 
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SUCCESSOR (SITE! 

calls:  LESSP, MAPC, GETATTB , GETATT, RETRIEVES 

called  by:  COURSE, SPEED 

binds :  PLAT, TOSSITE, TOSX, SUCC, TOSSUC, X 

SWEEPER  [CONDITION SECTIONS,  EV] 

calls:  MEMB, SWEEPER, ORHACK, NOTHACK, UNLESSHACK, ANDHACK, CONSTRUCT, 

GETMRVAL, APPLY 

called  by:  SWEEPER, APPLYRULE, ORHACK, ANDHACK, NOTHACK, UNLESSHACK 
binds:  THISCOND,C 

uses  free:  VDRELS 

SWR [LT1 , T1 , LT2 , T2 1 

calls :  CENTROID, LESSP, SPEEDM, DISTANCE 

binds:  L1,L2 

uses  free:  MAXSHIPSPEED 

IEKCOMISTR] 

calls:  PRIN1 , TERPRI 

called  by:  GRATEK , MONTEK 
uses  free:  TEKCOHCHAR 

TEKTEST [ ] 

calls :  CLEARBUF, PRINCHAR, TERPRI, DISMISS, PRINl , READP, ASKUSER, READ 

called  by:  CKCONF IGURATION 
binds:  UTEKFLG 

uses  free:  TEKCOHCHAR, TEK4025,TEKFLG 

TEKWAITU 

calls:  JSYS 

called  by:  WAITER, DSPERASE 

uses  free:  DSPTTYCODE, TEKFLG 

TRACK INPOLY [TRACK, POLY] 

calls :  SOHELINESEG, FUNCTION, LINPOLY 

binds:  TRACKPT1 , TRACKPT2 

IWO-*  PLACE  [Xl 

calls:  FQUOTIENT, FIX, FPLUS, FTIHES 

called  by:  MIDP, MODIFIER 

UNCRUNCH [NUM] 

calls:  RPTQ  ,  RPLACA ,  S2TN ,  LRSH ,  LLSH 

called  by:  DSPNUMAT 
binds:  PTR,RPTN 

uses  free:  SCRATCHFIVE 
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UNFREEZE [] 

calls:  MAPC,DREVERSE, APPLY* 

called  by:  MSGMTR 

binds:  XSUSP 

uses  free:  FREEZ ELST, FREEZ EFLG 

UNL  ESSHACK [ CONDITIONS , ACTIONS , EV ] 

calls:  ORACLEHACK, CASSERT, STRIPSTREAM, RETSTREAM, MAS SAG El , MAPRETRIEVE, 

FUNCT ION  ,  LEQ , GETCON , SWEEPER , CONS ,  LIST 
called  by:  SWEEPER 

binds:  P,X,CLIST 

VAR? [Q] 

calls:  CHCON1 

called  by:  MASSAGE1 , ORACLEHACK , PREPAL 1ST, RETSTREAM, RETV ARS, RETRIEVER 
WAITER! ] 

calls:  TERPRI,TEKWAIT,ASKUSER 

called  by:  DESCRIBEMSG, PRINTRULEASSR 
uses  free:  DUALFLG 

WEATHERMSG ( TXT] 

calls :  CASSERT, DSPADDTRH , MAPC, LIST, DSPADDINC, FLOAT 

called  by:  MSGMTR 

binds:  SNAME,LOC,STVER,TM 

uses  free:  DSPLAYFLG 

WELCOME ( ] 

calls :  PRIN1 , TERPRI , MAPC , CKCONFIGURATION, LINEREAD, PUTPROP 

called  by:  STAMMER 

binds:  NEWFL , TB 

uses  free:  ASSERTIONS, MSGFILE 

WENT- AFTER [ SI , T1 , S2 , T2 , S3 , T3 , S4 , T4 ] 

calls :  GREATERP, LESSP, CENTROID, DIRECTION, QUOTIENT, TIMES, COS, SIN, 

DIFFERENCE, LIST, PLUS , ARCTAN, ABS, DISTANCE 
binds :  PHI, VM1 , VM2 , VP1 , VP2 , P0 , P4 , PSI , THETA, INITDIST, ENDDIST, MINDIST, 

MINTIME, LI, L2,L3,L4 
uses  free:  PATROLRANG E , MAXS HIPSPEED 

WENT-BEFORE [ SI , T1 , S2 , T2 , S3 , T3 , S4 , T4 ] 

calls:  LESSP, GREATERP, CENTROID, DIRECTION, QUOTIENT, TIMES, COS, SIN, 

DIFFERENCE, LIST, PLUS, ARCTAN, ABS, DISTANCE 
binds :  PHI , VM1 , VM2 , VP1 , VP2 , P0 , P4 , PSI , THETA, INITDIST, FINDIST,  MINDIST, 

MINTIME, LI, L2,L3,L4 
uses  free:  PATROLRANG E,MAXSHIPSPEED 


WH AT2 FORMFN [ PL  ] 

calls:  APPEND, RETRIEVER, LIST 

WHATFORMFN [ REL , OBJ] 

calls:  RETRIEVER, L 1ST, MAPCAR,CDADR 

binds:  ANS 

uses  free:  WHATRES , WHATRES2 

WHOSE2 FORMFN I VAL , REL ] 

calls:  RETRIEVER, LIST, MAPCAR,CDADR 

binds:  ANS 

uses  free:  WHOSE2RES,WHOSE2RES2 
tfITHINRiL] 

calls:  NCONC, MAKEFILE 

uses  free:  WITHINRFNS 

YESNOlASSRSPEC] 

calls:  EQP, TERPRI , PRIN1 , GAMF , GETSTRIP, GETCON 

binds:  NDECON, NDE 
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